Expose infix viewing, replacement, mapping, and composition

fieldglass.ml

@@ -25,3 +25,11 @@ let _hd =
 let _tl =
   (fun source -> snd (split source)),
   (fun tail source -> fst (split source) :: tail)
+
+module Infix = struct
+  let ( ^. ) source focus = view focus source
+  let ( ^~ ) = set
+  let ( ^% ) focus f = over focus ~f
+  let ( ^> ) = compose
+  let ( ^< ) inner outer = compose outer inner
+end

fieldglass.mli

@@ -11,3 +11,11 @@ val _2 : ('c * 'a, 'c * 'b, 'a, 'b) lens
 val _id : ('a, 'b, 'a, 'b) lens
 val _hd : ('a list, 'a) lens'
 val _tl : ('a list, 'a list) lens'
+
+module Infix : sig
+  val ( ^. ) : 's -> ('s, 't, 'a, 'b) lens -> 'a
+  val ( ^~ ) : ('s, 't, 'a, 'b) lens -> 'b -> 's -> 't
+  val ( ^% ) : ('s, 't, 'a, 'b) lens -> ('a -> 'b) -> 's -> 't
+  val ( ^> ) : ('s, 't, 'a, 'b) lens -> ('a, 'b, 'c, 'd) lens -> ('s, 't, 'c, 'd) lens
+  val ( ^< ) : ('a, 'b, 'c, 'd) lens -> ('s, 't, 'a, 'b) lens -> ('s, 't, 'c, 'd) lens
+end

runtime.ml

@@ -40,3 +40,11 @@ let () =
     try action (); assert false with Invalid_argument _ -> ())
     [(fun () -> ignore (view _hd [])); (fun () -> ignore (view _tl []));
      (fun () -> ignore (set _hd 1 [])); (fun () -> ignore (set _tl [] []))]
+
+let () =
+  let open Infix in
+  assert ((9, false) ^. _1 = 9);
+  assert ((_2 ^~ "grey") (true, 9) = (true, "grey"));
+  assert ((_1 ^% succ) (9, false) = (10, false));
+  assert (((_1 ^> _2) ^~ 3) ((true, 9), false) = ((true, 3), false));
+  assert (((_2 ^< _1) ^~ 3) ((true, 9), false) = ((true, 3), false))