diff --git a/record.ml b/record.ml index 1aa8a02..52438d0 100644 --- a/record.ml +++ b/record.ml @@ -38,3 +38,17 @@ let () = (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" }) diff --git a/rewrite.ml b/rewrite.ml index 0c45f82..3a32276 100644 --- a/rewrite.ml +++ b/rewrite.ml @@ -41,7 +41,8 @@ let generate declaration = [Nolabel, Exp.field ~loc source (ident ~loc name)]))) in List.map (fun (name, body) -> Str.value ~loc Nonrecursive [Vb.mk ~loc (variable ~loc name) body]) - [name, getter; "set_" ^ name, setter; "update_" ^ name, updater]) fields) + [name, getter; "set_" ^ name, setter; "update_" ^ name, updater; + "_" ^ name, Exp.tuple ~loc [getter; setter]]) fields) let structure mapper items = List.concat (List.map (fun item ->