diff --git a/fieldglass.ml b/fieldglass.ml index 6141064..161718d 100644 --- a/fieldglass.ml +++ b/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 diff --git a/fieldglass.mli b/fieldglass.mli index e7d0452..2efa64c 100644 --- a/fieldglass.mli +++ b/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 diff --git a/runtime.ml b/runtime.ml index 50555f0..4dc66ab 100644 --- a/runtime.ml +++ b/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))