Extensible record by Lens trick in OCaml

extensible_record_by_lens.ml

(** The Lens trick: getter and setter for fields *)
type ('s, 'v) lens =
  {
    get: 's -> 'v;
    set: 'v -> 's -> 's;
  }

let id_lens = {
    get = (fun x -> x);
    set = (fun v _ -> v);
  }

(** Lens composition: ('c, 'b) lens -> ('a, 'c) lens -> ('a, 'b) lens *)
let ($$) k l =
  let get x = k.get (l.get x) in
  let set s x = l.set (k.set s (l.get x)) x in
  { get; set; }

(** As a super type *)
module M = struct
  type t = { foo: int; baz: string; }
  module F(S: sig type u val super : (u, t) lens end) = struct
    let foo = { get = (fun x -> x.foo); set = (fun v x -> { x with foo=v }) } $$ S.super
    let baz = { get = (fun x -> x.baz); set = (fun v x -> { x with baz=v }) } $$ S.super
  end
end

(** As a subtype *)
module K = struct
  type t = { super: M.t; hoge: float; }
  module F(S: sig type u val super : (u, t) lens end) = struct
    include M.F(struct
                 type u = S.u
                 let super = {
                     get = (fun x -> x.super);
                     set = (fun v x -> { x with super=v });
                   } $$ S.super
               end)
    let hoge = { get = (fun x -> x.hoge); set = (fun v x -> { x with hoge=v }) } $$ S.super
  end
end

module KK = K.F(struct type u = K.t let super = id_lens end)

(* results in `42' *)
let _ = KK.foo.get { K.super = { M.foo = 42; M.baz = "hello" }; K.hoge = 12.34 }