lens.ml

(* Compiled-infered types in comments *)
module Lens = struct
  (* 'a is "record" type, 'b is "field" type *)
  type ('a, 'b) getter = 'a -> 'b
  type ('a, 'b) setter = 'a -> 'b -> 'a
  type ('a, 'b) lens = ('a, 'b) getter * ('a, 'b) setter

  (* val read : ('a, 'b) lens -> 'a -> 'b *)
  let read (l : ('a, 'b) lens) (a : 'a) : 'b = (fst l) a
  (* val update : ('a, 'b) lens -> 'a -> 'b -> 'a *)
  let update (l : ('a, 'b) lens) (a : 'a) (b : 'b) : 'a = (snd l) a b

  (* Lens composition *)
  (* val ( <.> ) : ('a, 'b) lens -> ('c, 'a) lens -> ('c, 'b) lens *)
  let (<.>) (b : ('b, 'c) lens) (a : ('a, 'b) lens) : ('a, 'c) lens =
    (fun v -> fst b (fst a v)), (fun v n -> (snd a) v (snd b (fst a v) n))

  (* val multi_update : 'a -> (('a, 'b) lens * 'b) list -> 'a *)
  let multi_update v us =
    List.fold_left (fun a (l, v) -> update l a v) v us
  (* I wish this would be like
   * 'a -> forall b. (('a, b) lens * b) list -> 'a
   * or something along those lines, so what's commented-out in 'main' would
   * work/type-check.
   *)
end

module D : sig
  type t

  val make : int -> string -> t
  val to_string : t -> string

  val m : (t, int) Lens.lens
  val n : (t, string) Lens.lens
end = struct
  type t = { _m : int; _n : string }

  let make m n = { _m=m; _n=n }
  let to_string t =
    Printf.sprintf "{ _m=%d; _n=%s }" t._m t._n

  let m = (fun v -> v._m), (fun v m -> { v with _m=m })
  let n = (fun v -> v._n), (fun v n -> { v with _n=n })
end

let main () =
  let open Lens in

  let m1 = D.make 1 "Hello" in
  Printf.printf "%s\n" (D.to_string m1);

  let m2 = update D.m m1 2 in
  Printf.printf "%s\n" (D.to_string m2);

  let m3 = multi_update m2 [
    (D.n, "OCaml");
    (D.n, "world")
  ] in
  Printf.printf "%s\n" (D.to_string m3);

  (* This won't work:
  let m4 = multi_update m2 [
    (D.m, 3);
    (D.n, "big");
    (D.m, 4);
    (D.n, "world")
  ] in
  Printf.printf "%s\n" (D.to_string m3)
  *)

  ()

;;

main ()