module Colour = struct type t = { red : int; green : int; blue : int } [@@fieldglass generate] end module Legacy = struct type t = { value : string } [@@lens generate] end let () = let colour = Colour.{ red = 3; green = 4; blue = 5 } in assert (Colour.red colour = 3); assert (Colour.green colour = 4); assert (Legacy.value Legacy.{ value = "grey" } = "grey") module Box = struct type 'a t = { contents : 'a } [@@fieldglass generate] end module Mutable = struct type t = { mutable count : int; label : string } [@@fieldglass generate] end let () = let original = Colour.{ red = 3; green = 4; blue = 5 } in assert (Colour.set_red 8 original = Colour.{ red = 8; green = 4; blue = 5 }); assert (Colour.red original = 3); assert (Box.set_contents "grey" Box.{ contents = 9 } = Box.{ contents = "grey" }); let original = Mutable.{ count = 1; label = "grey" } in let changed = Mutable.set_count 2 original in assert (original.Mutable.count = 1 && changed.Mutable.count = 2) let () = let calls = ref 0 in let original = Colour.{ red = 3; green = 4; blue = 5 } in let changed = Colour.update_green ~f:(fun n -> incr calls; n + 1) original in assert (Colour.green changed = 5 && !calls = 1); assert (Box.update_contents ~f:string_of_int Box.{ contents = 9 } = Box.{ contents = "9" }); (try ignore (Colour.update_red ~f:(fun _ -> failwith "callback") original); assert false with Failure message -> assert (message = "callback")); assert (Colour.red original = 3) module Swatch = struct type t = { colour : Colour.t; label : string } [@@fieldglass generate] end let () = let open Fieldglass in let original = Swatch.{ colour = Colour.{ red = 3; green = 4; blue = 5 }; label = "grey" } in let focus = compose Swatch._colour Colour._red in assert (view focus original = 3); let changed = set focus 8 original in assert (view focus changed = 8 && Swatch.label changed = "grey"); assert (set focus (view focus original) original = original); assert (set Box._contents "grey" Box.{ contents = 9 } = Box.{ contents = "grey" })