From adc5d38b9b6984f6dc0af48f93a892979e269c85 Mon Sep 17 00:00:00 2001 From: sneeker Date: Sun, 24 Feb 2019 07:41:34 +0000 Subject: [PATCH] Provide the identity lens and verify composition identities --- fieldglass.ml | 1 + fieldglass.mli | 1 + runtime.ml | 5 +++++ 3 files changed, 7 insertions(+) diff --git a/fieldglass.ml b/fieldglass.ml index 4c1a91a..d275190 100644 --- a/fieldglass.ml +++ b/fieldglass.ml @@ -12,3 +12,4 @@ let compose (outer_get, outer_put) (inner_get, inner_put) = let _1 = (fun (left, _) -> left), (fun left (_, right) -> left, right) let _2 = (fun (_, right) -> right), (fun right (left, _) -> left, right) +let _id = (fun value -> value), (fun value _ -> value) diff --git a/fieldglass.mli b/fieldglass.mli index 1b91b6f..78af4db 100644 --- a/fieldglass.mli +++ b/fieldglass.mli @@ -8,3 +8,4 @@ val over : ('s, 't, 'a, 'b) lens -> f:('a -> 'b) -> 's -> 't val compose : ('s, 't, 'a, 'b) lens -> ('a, 'b, 'c, 'd) lens -> ('s, 't, 'c, 'd) lens val _1 : ('a * 'c, 'b * 'c, 'a, 'b) lens val _2 : ('c * 'a, 'c * 'b, 'a, 'b) lens +val _id : ('a, 'b, 'a, 'b) lens diff --git a/runtime.ml b/runtime.ml index 7e9b8b8..b5d2b51 100644 --- a/runtime.ml +++ b/runtime.ml @@ -25,3 +25,8 @@ let () = assert (set _1 "grey" (1, true) = ("grey", true)); assert (over _2 ~f:string_of_int (false, 9) = (false, "9")); assert (view (compose _1 _2) ((true, "grey"), ()) = "grey") + +let () = + assert (set _id "grey" 9 = "grey"); + assert (view (compose _id _1) (9, false) = view _1 (9, false)); + assert (set (compose _2 _id) "grey" (true, 9) = set _2 "grey" (true, 9))