Implement replacement and functional updates with lens-law checks

This commit is contained in:
milner committed 2019-02-17 03:07:54 +00:00
1 parent d30dc5d519
commit 0f219fea14
3 files changed
+13

No files matched your search

+2
View File
@@ -3,3 +3,5 @@ type ('s, 'a) lens' = ('s, 's, 'a, 'a) lens
let lens ~view ~set = view, set let lens ~view ~set = view, set
let view (get, _) = get let view (get, _) = get
let set (_, put) = put
let over (get, put) ~f source = put (f (get source)) source
+2
View File
@@ -3,3 +3,5 @@ type ('s, 'a) lens' = ('s, 's, 'a, 'a) lens
val lens : view:('s -> 'a) -> set:('b -> 's -> 't) -> ('s, 't, 'a, 'b) lens val lens : view:('s -> 'a) -> set:('b -> 's -> 't) -> ('s, 't, 'a, 'b) lens
val view : ('s, 't, 'a, 'b) lens -> 's -> 'a val view : ('s, 't, 'a, 'b) lens -> 's -> 'a
val set : ('s, 't, 'a, 'b) lens -> 'b -> 's -> 't
val over : ('s, 't, 'a, 'b) lens -> f:('a -> 'b) -> 's -> 't
+9
View File
@@ -4,3 +4,12 @@ let sample : (string * bool, string) lens' =
lens ~view:fst ~set:(fun value (_, other) -> value, other) lens ~view:fst ~set:(fun value (_, other) -> value, other)
let () = assert (view sample ("colour", true) = "colour") let () = assert (view sample ("colour", true) = "colour")
let () =
let source = "colour", true in
assert (set sample "grey" source = ("grey", true));
assert (set sample (view sample source) source = source);
assert (set sample "blue" (set sample "grey" source) = set sample "blue" source);
let calls = ref 0 in
assert (over sample ~f:(fun text -> incr calls; text ^ "s") source = ("colours", true));
assert (!calls = 1)