OCaml/Lwt crash course. Adult supervision recommended.

ocaml_lwt_sample.ml

(*
   Interactive approach
   --------------------

   You can copy-paste code into `utop`, provided you load the lwt.unix
   package:

     #use "topfind";;
     #require "lwt.unix";;

   Each statement must be followed by `;;` to let utop know that you're done.

   You can also load the whole file using `#use`:

     #use "ocaml_lwt_sample.ml";;

   Standalone executable
   ---------------------

   You an compile this program into a standalone executable
   with the following command:

     ocamlfind opt -o ocaml_lwt_sample -package lwt.unix -linkpkg \
       ocaml_lwt_sample.ml

   Then run it:

     ./ocaml_lwt_sample
*)

(*** Basic syntax ***)

(* Compute an int and call it `four`. It is immutable. *)
let four = 2 + 2

let greeting = "Yo"

(* Function definition. One argument of type `unit`. *)
let hello () =
  (* Call a function of one argument *)
  print_endline greeting

(* Another variable `greeting` that shadows the first one only in the
   code that follows. *)
let greeting = "Hello"

(* Syntax wart - this phony `let` is how we avoid sticking `;;` everywhere *)
let () = hello ()

(* Note that we printed `Yo`, not `Hello` *)

(* Function of multiple arguments *)
let add a b =
  a + b

(* Partial application: `add2 x` calls `add 2 x` *)
let add2 = add 2

(* Often we avoid partial application for more clarity *)
let add3 x =
  add 3 x

(* When several arguments have the same type or there are many arguments,
   we label them. *)
let say_hello ~greeting ~name =
  Printf.printf "%s %s.\n" greeting name

(* Calling functions with labeled arguments is accepted by the compiler
   only if the labels are correct. Argument no longer matters since the
   arguments are labeled. *)
let () = say_hello ~name:"there" ~greeting:"Hi"

(* Optional arguments *)
let say_hello2 ?(greeting = "Hi") ~name () =
  Printf.printf "%s %s.\n" greeting name

(* We can omit optional arguments or not. *)
let () = say_hello2 ~name:"you" ()
let () = say_hello2 ~greeting:"Hello" ~name:"programmer" ()

(* Pattern-matching *)
let is_hello s =
  match s with
  | "Hello" | "hello" -> true
  | _ (* otherwise *) -> false

(* Type definitions *)
type time = int  (* an alias *)

(* A record type definition *)
type profile = {
  name: string;
  age: int;
}

(* Variants *)
type color = Green | Red
type fruit = Banana | Apple of color

(* Polymorphic variants: same as regular variants but they
   don't need a type definition, although it's recommended to simplify
   to error messages.
*)
type result = [ `OK | `Error of string ]

(* Parametrized types *)
type 'a stuff = (* equivalent to Stuff<A> in other languages *)
  {
    id: string;
    items: 'a list
  }

(* More pattern-matching *)

let give_me_a_result () : result (* optional type annotation *) =
  `Error "This is a test"

let success =
  match give_me_a_result () with
  | `OK -> true
  | `Error _ -> false

(* Lists - immutable singly-linked lists.
   They're the default data structure for storing collections of items.
   These are not suitable for random access.

   A list is either the empty list denoted `[]`
   or a pair of the first element called the head and the rest of the list
   called the tail, e.g. `element :: other_elements`
*)
let list0 = 1 :: (2 :: (3 :: []))
let list1 = 1 :: 2 :: 3 :: []     (* same as list0 *)
let list2 = [1; 2; 3]             (* same as list1 *)

(* More pattern-matching *)

let first_fruit_is_an_apple fruits =
  match fruits with
  | [] -> false
  | Banana :: _ -> false
  | Apple _ :: _ -> true

(* Simpler code that will break silently if an
   `Apple2` case is added to the type definition later: *)
let fragile_first_fruit_is_an_apple fruits =
  match fruits with
  | Apple _ :: _ -> true
  | _ -> false

(* Recursive functions require the `rec` keyword (but type definitions are
   implicitly recursive). We don't need to write recursive functions
   too often in "enterprise" code but this is how all iterators
   over lists are defined, and sometimes it's better to write our own.

   The following is the same as the standard `List.filter`.
*)
let rec filter predicate list =
  match list with
  | [] -> []
  | head :: tail ->
      if predicate head then
        head :: filter predicate tail
      else
        filter predicate tail

(* Similar code that performs the tests from right to left instead
   but otherwise returns the same result
   (assuming `predicate` is stateless). *)
let rec filter2 predicate list =
  match list with
  | [] -> []
  | head :: tail ->
      let new_tail = filter predicate tail in
      if predicate head then
        head :: new_tail
      else
        new_tail

let is_even x =
  x mod 2 = 0

let filtered_list = filter is_even [0; 2; 3; 4; 5; 88; 99]

(* Using an anonymous function *)
let filtered_list2 = filter (fun x -> x mod 2 = 0) [0; 2; 3; 4; 5; 88; 99]

(* Exercises:

   1. Implement the `iter` function, which takes a function and a list,
      and applies the function to each element of the list from
      left to right:

        iter print_endline ["a"; "b"; "c"]

      must print:

        a
        b
        c

   2. Define your own list type as a variant type
      without the special syntax `[]` and `::`.

   3. Modify your `iter` function to work on your own list type instead.
*)

(* The built-in option type
   Defined as:

   type 'a option = None | Some of 'a
 *)
let obtain_value default_value optional_value =
  match optional_value with
  | None -> default_value
  | Some x -> x

(* Optional arguments without a default use the option type *)
let show_optional_arg ?x () =
  x

(* Exceptions

   Exceptions are of the type `exn` which is a special variant type
   than can be extended with new cases.
 *)
exception Fishsticks of string
  (* Now `Fishsticks "uh oh"` is a valid value for the type `exn`. *)

(* Catching exceptions *)
let found =
  try
    Some (List.find (fun x -> x < 0) [1;2;3])
  with Not_found ->
    None

(* Tuples *)
let some_stuff = (123, "abc", None)

(*** Mutable stuff ***)

(* Records with mutable fields: not often used directly *)
type point = {
  mutable x: int;
  mutable y: int;
}

let p =
  let p = { x = 0; y = 0 } in
  p.x <- 123;
  p

(* References: a single mutable cell.
   Predefined as:

     type 'a ref = { mutable contents : 'a }

   References come with 2 handy set/get operators `:=` and `!`,
   plus `incr` and `decr` to operate on counters.
*)
let counter = ref 0

let () =
  counter := 10

let ten = !counter

let () =
  counter := !counter + 1

let eleven = !counter

let () = incr counter

let twelve = !counter

(* Assertions *)
let () =
  assert (ten = 10);
  assert (eleven = 11);
  assert (twelve = 12)

(* Arrays: for efficient random access and mutability *)
let some_array = [| 123; 45; 678 |]
let fortyfive = some_array.(1)

(*** Modules ***)

(*
   Each .ml source file results in a module after capitalization.
   The standard library has a source file `printf.ml`.
*)
open Printf

let say_hello3 ?(greeting = "Hello") name =
  (* instead of Printf.printf *)
  printf "%s %s.\n" greeting name

(* We can also define submodules as follows *)
module Op = struct
  let (=) a b =
    String.lowercase a = String.lowercase b
end

let result1 = "Pistachio" = "pistachio"      (* false *)
let result2 = Op.("Pistachio" = "pistachio") (* true *)

(* Same as result2 definition, alternative syntax *)
let result3 =
  let open Op in
  "Pistachio" = "pistachio"


(*** Asynchronous programming with Lwt ***)

(*
   Lwt is a regular OCaml library that supports a "cooperative threads" model,
   similar to JavaScript.

   Each computation is called a thread, but only one thread can run at once.
   A thread is typically defined as an anonymous function that will
   be called after the result of some other thread becomes available,
   with a possible delay.

   A thread is an opaque object of type `'a Lwt.t`, representing
   the asynchronous computation of a value of type 'a.

   Which thread runs at a given time is determined by a scheduler,
   which is launched by the function `Lwt_main.run`.

   When a thread terminates ("resolves"), it is in either of these states:
   - successful, holding a result
   - failed, holding an exception

   Waiting on the thread is done using the bind operator `(>>=)` which
   is the same function as `Lwt.bind`.
*)

(* Make `(>>=)` available. *)
open Lwt

(* Sleep 1.5 seconds, then make the result `()` available. *)
let wait_for_a_while () =
  Lwt_unix.sleep 1.5

let () =
  Lwt_main.run (wait_for_a_while ())

(* `Lwt.return` wraps an OCaml value into a resolved lwt thread *)
let print_message_after_a_while () =
  wait_for_a_while () >>= (fun () -> print_endline "done"; Lwt.return ())

(*
   Several threads can wait on a given thread.
   There's no guarantee on the order in which threads 1,2,3 will run.
   Worse, the threads 1 and 2 are ignored, i.e. the main loop
   `Lwt_main.run` won't wait for them. If thread 3 finishes first,
   `1` and `2` won't be printed.
*)
let print_messages_after_a_while_v1 () =
  let timer = wait_for_a_while () in
  ignore (timer >>= fun () -> print_endline "1"; Lwt.return ());
  ignore (timer >>= fun () -> print_endline "2"; Lwt.return ());
  timer >>= fun () -> print_endline "3"; Lwt.return ()

let () =
  print_endline "print_messages_after_a_while_v1";
  Lwt_main.run (print_messages_after_a_while_v1 ())

(* Better, make sure to wait for the 3 threads.
   Additionally, we print a message when we're done with all 3 threads. *)
let print_messages_after_a_while_v2 () =
  let timer = wait_for_a_while () in
  let t1 = timer >>= fun () -> print_endline "1"; Lwt.return () in
  let t2 = timer >>= fun () -> print_endline "2"; Lwt.return () in
  let t3 = timer >>= fun () -> print_endline "3"; Lwt.return () in
  Lwt.join [t1; t2; t3] >>= fun () ->
  print_endline "all done";
  Lwt.return ()

let () =
  print_endline "print_messages_after_a_while_v2";
  Lwt_main.run (print_messages_after_a_while_v2 ())

(* Exceptions are propagated along bind points. If a thread B waits for its
   input from another thread A but A results in an exception, then
   B resolves to the same exception. *)
let make_thread_that_fails () =
  Lwt_unix.sleep 0.1 >>= fun () ->
  failwith "Uh oh" (* raises the exception `Failure "Uh oh"` *) >>= fun () ->
  print_endline "This never happens.";
  Lwt.return ()

let report_error thread_name make_thread =
  Lwt.catch
    (fun () -> make_thread ())
    (fun e ->
       Printf.eprintf "Expected exception in thread %s: %s\n"
         thread_name
         (Printexc.to_string e);
       return ()
    )

let () =
  let thread = report_error "thread-that-fails" make_thread_that_fails in
  Lwt_main.run thread