OCaml Functional Programming: Panduan Lengkap Algebraic Types, Pattern Matching, dan Modules

# macOS
brew install opam

# Ubuntu/Debian
sudo apt install opam

# Inisialisasi opam (pertama kali)
opam init

# Buat switch (versi OCaml) baru
opam switch create 5.1.0
eval $(opam env)

# Verifikasi
ocaml --version
# OCaml version 5.1.0

# Install dune (build system)
opam install dune utop

# Jalankan OCaml REPL
utop

# Buat proyek baru dengan dune
dune init project my_project
cd my_project
dune build
dune exec my_project

(* OCaml adalah expression-oriented, hampir semua adalah expression *)

(* Let bindings (immutable by default) *)
let nama = "BeebaneLabs"
let umur = 25
let pi = 3.14159

(* Type inference - compiler tahu tipenya *)
let x = 42          (* int *)
let y = 3.14        (* float *)
let s = "hello"     (* string *)
let b = true        (* bool *)
let c = 'a'         (* char *)

(* Explicit type annotation *)
let umur : int = 25
let nama : string = "Andi"

(* Let ... in - scope *)
let hasil =
  let a = 10 in
  let b = 20 in
  a + b   (* 30 *)

(* Printf *)
let () = Printf.printf "Nama: %s, Umur: %d\n" nama umur

(* Type conversion *)
let float_val = float_of_int 42     (* 42.0 *)
let int_val = int_of_float 3.14     (* 3 *)
let str_val = string_of_int 42      (* "42" *)
let parsed = int_of_string "123"    (* 123 *)

(* Basic function *)
let tambah a b = a + b

(* Dengan type annotations *)
let tambah_explicit (a : int) (b : int) : int = a + b

(* Recursive functions harus menggunakan 'rec' *)
let rec factorial n =
  if n <= 1 then 1
  else n * factorial (n - 1)

(* Recursive dengan pattern matching *)
let rec fibonacci = function
  | 0 -> 0
  | 1 -> 1
  | n -> fibonacci (n - 1) + fibonacci (n - 2)

(* Anonymous functions *)
let kuadrat = fun x -> x * x
let tambah_tiga = fun x -> x + 3

(* Partial application *)
let kali = fun a b -> a * b
let kali_dua = kali 2    (* partially applied *)
let hasil = kali_dua 5   (* 10 *)

(* Labeled arguments *)
let buat_user ~nama ~umur =
  Printf.sprintf "%s (umur: %d)" nama umur

let user = buat_user ~umur:25 ~nama:"Andi"

(* Optional arguments *)
let greet ?(greeting="Halo") nama =
  Printf.sprintf "%s, %s!" greeting nama

let () =
  Printf.printf "%s\n" (greet "Andi");           (* Halo, Andi! *)
  Printf.printf "%s\n" (greet ~greeting:"Hi" "Andi")  (* Hi, Andi! *)

(* Higher-order functions *)
let apply_twice f x = f (f x)
let hasil = apply_twice (fun x -> x + 3) 10  (* 16 *)

let () = Printf.printf "Factorial 5: %d\n" (factorial 5)
let () = Printf.printf "Fibonacci 10: %d\n" (fibonacci 10)

(* Tuples *)
let pasangan = (42, "hello")
let (angka, teks) = pasangan  (* destructuring *)
let pertama = fst pasangan     (* 42 *)
let kedua = snd pasangan       (* "hello" *)

(* Triple dan tuple besar *)
let triple = (1, "dua", 3.0)

(* Records *)
type mahasiswa = {
  nama : string;
  nim : int;
  ipk : float;
}

let mhs = { nama = "Andi"; nim = 2024001; ipk = 3.75 }
let nama_mhs = mhs.nama  (* "Andi" *)

(* Update record (immutable) *)
let mhs_baru = { mhs with ipk = 3.80 }

(* Lists (immutable, linked list) *)
let angka = [1; 2; 3; 4; 5]
let gabung = 0 :: angka       (* [0; 1; 2; 3; 4; 5] *)
let gabung2 = angka @ [6; 7]  (* [1; 2; 3; 4; 5; 6; 7] *)

(* List operations *)
let panjang = List.length angka           (* 5 *)
let terbalik = List.rev angka             (* [5; 4; 3; 2; 1] *)
let dipetakan = List.map (fun x -> x * 2) angka  (* [2; 4; 6; 8; 10] *)
let difilter = List.filter (fun x -> x > 3) angka  (* [4; 5] *)
let total = List.fold_left (+) 0 angka    (* 15 *)

(* Arrays (mutable) *)
let arr = [| 10; 20; 30; 40; 50 |]
arr.(0) <- 99  (* update elemen pertama *)

(* Hashtbl (hash table) *)
let tbl = Hashtbl.create 16
let () =
  Hashtbl.add tbl "apel" 5;
  Hashtbl.add tbl "jeruk" 3;
  Printf.printf "apel: %d\n" (Hashtbl.find tbl "apel")

(* Variant types (sum types) *)
type warna = Merah | Hijau | Biru | Kuning

(* Variant dengan data *)
type bentuk =
  | Lingkaran of float                (* radius *)
  | Persegi of float                  (* sisi *)
  | Segitiga of float * float         (* alas, tinggi *)
  | PersegiPanjang of float * float   (* panjang, lebar *)

let luas = function
  | Lingkaran r -> Float.pi *. r *. r
  | Persegi s -> s *. s
  | Segitiga (a, t) -> 0.5 *. a *. t
  | PersegiPanjang (p, l) -> p *. l

(* Recursive types *)
type 'a daftar =
  | Kosong
  | Simpul of 'a * 'a daftar

let contoh = Simpul (1, Simpul (2, Simpul (3, Kosong)))

let rec panjang = function
  | Kosong -> 0
  | Simpul (_, tail) -> 1 + panjang tail

(* Option type (built-in, menggantikan null) *)
type 'a option = None | Some of 'a

let cari_di_list lst idx =
  if idx < 0 || idx >= List.length lst then None
  else Some (List.nth lst idx)

let hasil = cari_di_list [10; 20; 30] 1  (* Some 20 *)
let gagal = cari_di_list [10; 20; 30] 5  (* None *)

(* Result type untuk error handling *)
type ('ok, 'error) result = Ok of 'error | Error of 'error

let parse_int s =
  try Ok (int_of_string s)
  with Failure msg -> Error msg

(* Parameterized types *)
type ('a, 'b) pasangan = { fst: 'a; snd: 'b }

type 'a tree =
  | Leaf
  | Node of 'a tree * 'a * 'a tree

let contoh_tree =
  Node (
    Node (Leaf, 1, Leaf),
    2,
    Node (Leaf, 3, Leaf)
  )

let rec hitung_node = function
  | Leaf -> 0
  | Node (left, _, right) -> 1 + hitung_node left + hitung_node right

(* Polymorphic variants *)
type warna_dasar = [ `Merah | `Hijau | `Biru ]
type warna_tambahan = [ `Kuning | `Ungu ]
type semua_warna = [ warna_dasar | warna_tambahan ]

let ke_string = function
  | `Merah -> "merah"
  | `Hijau -> "hijau"
  | `Biru -> "biru"
  | `Kuning -> "kuning"
  | `Ungu -> "ungu"

(* Representasi expression tree *)
type expr =
  | Bilangan of float
  | Tambah of expr * expr
  | Kurang of expr * expr
  | Kali of expr * expr
  | Bagi of expr * expr
  | Negasi of expr

(* Evaluasi expression *)
let rec eval = function
  | Bilangan n -> n
  | Tambah (a, b) -> eval a +. eval b
  | Kurang (a, b) -> eval a -. eval b
  | Kali (a, b) -> eval a *. eval b
  | Bagi (a, b) -> eval a /. eval b
  | Negasi a -> -.(eval a)

(* Pretty print expression *)
let rec to_string = function
  | Bilangan n -> string_of_float n
  | Tambah (a, b) -> Printf.sprintf "(%s + %s)" (to_string a) (to_string b)
  | Kurang (a, b) -> Printf.sprintf "(%s - %s)" (to_string a) (to_string b)
  | Kali (a, b) -> Printf.sprintf "(%s * %s)" (to_string a) (to_string b)
  | Bagi (a, b) -> Printf.sprintf "(%s / %s)" (to_string a) (to_string b)
  | Negasi a -> Printf.sprintf "(-%s)" (to_string a)

(* Contoh: (2 + 3) * 4 *)
let expr1 =
  Kali (
    Tambah (Bilangan 2.0, Bilangan 3.0),
    Bilangan 4.0
  )

let () =
  Printf.printf "Expression: %s\n" (to_string expr1);
  Printf.printf "Result: %f\n" (eval expr1)
  (* Expression: ((2. + 3.) * 4.)
     Result: 20.000000 *)

(* Match expression *)
let describe_number n =
  match n with
  | 0 -> "nol"
  | 1 -> "satu"
  | 2 -> "dua"
  | n when n > 0 -> "positif"
  | _ -> "negatif"

(* Pattern matching pada tuples *)
let classify_point = function
  | (0, 0) -> "origin"
  | (x, 0) -> Printf.sprintf "pada sumbu x: %d" x
  | (0, y) -> Printf.sprintf "pada sumbu y: %d" y
  | (x, y) when x > 0 && y > 0 -> "kuadran I"
  | (x, y) when x < 0 && y > 0 -> "kuadran II"
  | (x, y) when x < 0 && y < 0 -> "kuadran III"
  | _ -> "kuadran IV"

(* Pattern matching pada lists *)
let rec list_sum = function
  | [] -> 0
  | [x] -> x
  | head :: tail -> head + list_sum tail

let describe_list = function
  | [] -> "list kosong"
  | [x] -> Printf.sprintf "satu elemen: %d" x
  | [x; y] -> Printf.sprintf "dua elemen: %d, %d" x y
  | head :: _ -> Printf.sprintf "banyak elemen, mulai dari %d" head

(* Nested pattern matching *)
type 'a tree = Leaf | Node of 'a tree * 'a * 'a tree

let rec search_tree target = function
  | Leaf -> false
  | Node (_, value, _) when value = target -> true
  | Node (left, _, right) ->
    search_tree target left || search_tree target right

(* Guard clauses *)
let classify_grade = function
  | grade when grade >= 90 -> "A"
  | grade when grade >= 80 -> "B"
  | grade when grade >= 70 -> "C"
  | grade when grade >= 60 -> "D"
  | _ -> "F"

(* Exhaustive matching - compiler warns jika ada case yang terlewat *)
type hari = Senin | Selasa | Rabu | Kamis | Jumat | Sabtu | Minggu

let is_weekend = function
  | Sabtu | Minggu -> true
  | Senin | Selasa | Rabu | Kamis | Jumat -> false

(* Or patterns *)
let is_vokal = function
  | 'a' | 'i' | 'u' | 'e' | 'o' -> true
  | 'A' | 'I' | 'U' | 'E' | 'O' -> true
  | _ -> false

let () =
  Printf.printf "%s\n" (describe_number 0);
  Printf.printf "%s\n" (classify_point (3, -2));
  Printf.printf "%s\n" (describe_list [1; 2; 3; 4; 5]);
  Printf.printf "%s\n" (is_weekend Sabtu |> string_of_bool)

(* Module definition *)
module MathUtils = struct
  let pi = 3.14159265358979
  let e = 2.71828182845904

  let square x = x * x
  let cube x = x * x * x

  let rec power base = function
    | 0 -> 1
    | n -> base * power base (n - 1)

  let abs x = if x < 0 then -x else x
end

(* Module type (signature/interface) *)
module type STACK = sig
  type 'a t
  val empty : 'a t
  val push : 'a -> 'a t -> 'a t
  val pop : 'a t -> ('a * 'a t) option
  val peek : 'a t -> 'a option
  val is_empty : 'a t -> bool
  val size : 'a t -> int
end

(* Module implementation *)
module Stack : STACK = struct
  type 'a t = 'a list

  let empty = []
  let push x s = x :: s

  let pop = function
    | [] -> None
    | x :: rest -> Some (x, rest)

  let peek = function
    | [] -> None
    | x :: _ -> Some x

  let is_empty = function
    | [] -> true
    | _ -> false

  let size = List.length
end

(* Using modules *)
let () =
  Printf.printf "Pi: %f\n" MathUtils.pi;
  Printf.printf "5^3: %d\n" (MathUtils.power 5 3);

  let stack = Stack.empty in
  let stack = Stack.push 1 stack in
  let stack = Stack.push 2 stack in
  let stack = Stack.push 3 stack in
  Printf.printf "Stack size: %d\n" (Stack.size stack);

  match Stack.pop stack with
  | Some (value, rest) ->
    Printf.printf "Popped: %d, Remaining: %d\n" value (Stack.size rest)
  | None -> Printf.printf "Stack kosong\n"

(* Module dengan type abstraction *)
module type MAP = sig
  type ('k, 'v) t
  val empty : ('k, 'v) t
  val add : 'k -> 'v -> ('k, 'v) t -> ('k, 'v) t
  val find : 'k -> ('k, 'v) t -> 'v option
  val remove : 'k -> ('k, 'v) t -> ('k, 'v) t
  val to_list : ('k, 'v) t -> ('k * 'v) list
end

module SimpleMap : MAP = struct
  type ('k, 'v) t = ('k * 'v) list

  let empty = []

  let add key value map =
    (key, value) :: List.filter (fun (k, _) -> k <> key) map

  let find key map =
    try Some (List.assoc key map)
    with Not_found -> None

  let remove key map =
    List.filter (fun (k, _) -> k <> key) map

  let to_list map = map
end

(* Include - module inheritance *)
module ExtendedMath = struct
  include MathUtils

  let rec factorial = function
    | 0 -> 1
    | n -> n * factorial (n - 1)

  let fibonacci n =
    let rec aux a b = function
      | 0 -> a
      | n -> aux b (a + b) (n - 1)
    in
    aux 0 1 n
end

(* Module type untuk elemen yang bisa di-compare *)
module type COMPARABLE = sig
  type t
  val compare : t -> t -> int
  val to_string : t -> string
end

(* Functor: buat Set dari COMPARABLE *)
module MakeSet (C : COMPARABLE) = struct
  type t = C.t list

  let empty = []

  let rec add x = function
    | [] -> [x]
    | hd :: tl ->
      let cmp = C.compare x hd in
      if cmp = 0 then hd :: tl
      else if cmp < 0 then x :: hd :: tl
      else hd :: add x tl

  let rec mem x = function
    | [] -> false
    | hd :: tl ->
      let cmp = C.compare x hd in
      if cmp = 0 then true
      else if cmp < 0 then false
      else mem x tl

  let rec remove x = function
    | [] -> []
    | hd :: tl ->
      let cmp = C.compare x hd in
      if cmp = 0 then tl
      else if cmp < 0 then hd :: tl
      else hd :: remove x tl

  let to_list s = s

  let size = List.length

  let print s =
    List.iter (fun x -> Printf.printf "%s " (C.to_string x)) s;
    Printf.printf "\n"
end

(* Implement COMPARABLE untuk integer *)
module IntComparable : COMPARABLE with type t = int = struct
  type t = int
  let compare = compare
  let to_string = string_of_int
end

(* Implement COMPARABLE untuk string *)
module StringComparable : COMPARABLE with type t = string = struct
  type t = string
  let compare = String.compare
  let to_string s = s
end

(* Buat Set menggunakan functor *)
module IntSet = MakeSet(IntComparable)
module StringSet = MakeSet(StringComparable)

let () =
  (* IntSet *)
  let s = IntSet.empty in
  let s = IntSet.add 3 s in
  let s = IntSet.add 1 s in
  let s = IntSet.add 5 s in
  let s = IntSet.add 2 s in
  Printf.printf "IntSet: ";
  IntSet.print s;
  Printf.printf "Contains 3: %b\n" (IntSet.mem 3 s);
  Printf.printf "Size: %d\n" (IntSet.size s);

  (* StringSet *)
  let ss = StringSet.empty in
  let ss = StringSet.add "apel" ss in
  let ss = StringSet.add "jeruk" ss in
  let ss = StringSet.add "mangga" ss in
  Printf.printf "StringSet: ";
  StringSet.print ss

(* Higher-order functions yang sering digunakan *)

(* Map - transformasi *)
let doubles = List.map (fun x -> x * 2) [1; 2; 3; 4; 5]
(* [2; 4; 6; 8; 10] *)

(* Filter - penyaringan *)
let evens = List.filter (fun x -> x mod 2 = 0) [1; 2; 3; 4; 5]
(* [2; 4] *)

(* Fold - akumulasi *)
let sum = List.fold_left (+) 0 [1; 2; 3; 4; 5]
(* 15 *)

let product = List.fold_left ( * ) 1 [1; 2; 3; 4; 5]
(* 120 *)

(* Fold right *)
let concat = List.fold_right (fun x acc -> acc ^ x) ["a"; "b"; "c"] ""
(* "cba" *)

(* For all dan exists *)
let semua_positif = List.for_all (fun x -> x > 0) [1; 2; 3]
let ada_genap = List.exists (fun x -> x mod 2 = 0) [1; 3; 4; 5]

(* Function composition *)
let compose f g x = f (g x)
let kuadrat_tambah_satu = compose (fun x -> x + 1) (fun x -> x * x)

(* Pipeline operator *)
let (|>) x f = f x

let hasil =
  [1; 2; 3; 4; 5]
  |> List.map (fun x -> x * 2)
  |> List.filter (fun x -> x > 4)
  |> List.fold_left (+) 0
  (* 6 + 8 + 10 = 24 *)

(* Currying *)
let add a b = a + b
let add_5 = add 5  (* partial application *)
let result = add_5 3  (* 8 *)

(* Map dan Set dengan custom comparator *)
module IntMap = Map.Make(struct
  type t = int
  let compare = compare
end)

let map =
  IntMap.empty
  |> IntMap.add 1 "satu"
  |> IntMap.add 2 "dua"
  |> IntMap.add 3 "tiga"

let () =
  Printf.printf "Sum: %d\n" sum;
  Printf.printf "Result: %d\n" hasil;
  IntMap.iter (fun k v -> Printf.printf "%d -> %s\n" k v) map

(* References - mutable values *)
let counter = ref 0

let increment () =
  counter := !counter + 1

let get_count () = !counter

(* Ref sebagai parameter *)
let push item stack_ref =
  stack_ref := item :: !stack_ref

let pop stack_ref =
  match !stack_ref with
  | [] -> None
  | hd :: tl ->
    stack_ref := tl;
    Some hd

(* Mutable record fields *)
type point = {
  mutable x : float;
  mutable y : float;
}

let move p dx dy =
  p.x <- p.x +. dx;
  p.y <- p.y +. dy

(* Imperative loop dengan for *)
let () =
  for i = 1 to 10 do
    Printf.printf "%d " i
  done;
  Printf.printf "\n"

(* While loop *)
let () =
  let i = ref 0 in
  while !i < 10 do
    Printf.printf "%d " !i;
    i := !i + 1
  done;
  Printf.printf "\n"

(* Mutable array operations *)
let () =
  let arr = [| 1; 2; 3; 4; 5 |] in
  arr.(0) <- 99;
  Array.iter (fun x -> Printf.printf "%d " x) arr;
  Printf.printf "\n"

(* Queue (mutable) *)
module MutableQueue = struct
  type 'a t = {
    mutable elements : 'a list;
    mutable length : int;
  }

  let create () = { elements = []; length = 0 }

  let push item q =
    q.elements <- q.elements @ [item];
    q.length <- q.length + 1

  let pop q =
    match q.elements with
    | [] -> None
    | hd :: tl ->
      q.elements <- tl;
      q.length <- q.length - 1;
      Some hd

  let length q = q.length
end

(* Option type *)
let safe_divide a b =
  if b = 0 then None
  else Some (a / b)

let rec find_first pred = function
  | [] -> None
  | hd :: tl -> if pred hd then Some hd else find_first pred tl

(* Result type *)
type ('a, 'e) result = Ok of 'a | Error of 'e

let parse_age s =
  try
    let n = int_of_string s in
    if n >= 0 && n <= 150 then Ok n
    else Error "Umur harus antara 0 dan 150"
  with Failure _ -> Error "Bukan angka valid"

let validate_email email =
  if String.contains email '@' then Ok email
  else Error "Email tidak valid"

let validate_name name =
  if String.length name >= 2 then Ok name
  else Error "Nama minimal 2 karakter"

(* Monadic chaining *)
let bind result f =
  match result with
  | Ok value -> f value
  | Error msg -> Error msg

(* Registration pipeline *)
let register name email age_str =
  validate_name name
  |> bind (fun valid_name ->
    validate_email email
    |> bind (fun valid_email ->
      parse_age age_str
      |> bind (fun age ->
        Ok (Printf.sprintf "User: %s, Email: %s, Age: %d"
              valid_name valid_email age)
      )
    )
  )

let () =
  match register "Andi" "andi@email.com" "25" with
  | Ok msg -> Printf.printf "Berhasil: %s\n" msg
  | Error err -> Printf.printf "Gagal: %s\n" err;

  match register "A" "invalid" "abc" with
  | Ok msg -> Printf.printf "Berhasil: %s\n" msg
  | Error err -> Printf.printf "Gagal: %s\n" err