136 lines
4.7 KiB
OCaml
136 lines
4.7 KiB
OCaml
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" })
|
|
|
|
module Prefixed = struct
|
|
type t = { paint_colour_red : int; paint_colour_green : int } [@@fieldglass generate]
|
|
end
|
|
|
|
module Unprefixed = struct
|
|
type t = { yes : bool; yellow : bool } [@@fieldglass generate]
|
|
end
|
|
|
|
module Single = struct
|
|
type t = { paint_red : int } [@@fieldglass generate]
|
|
end
|
|
|
|
let () =
|
|
assert (Prefixed.red Prefixed.{ paint_colour_red = 3; paint_colour_green = 4 } = 3);
|
|
assert (Unprefixed.yes Unprefixed.{ yes = true; yellow = false });
|
|
assert (Single.paint_red Single.{ paint_red = 3 } = 3)
|
|
|
|
module Named = struct
|
|
type t = { item_colour : string; item_size : int }
|
|
[@@fieldglass generate ~field_prefix:swatch]
|
|
end
|
|
|
|
module Typed = struct
|
|
type swatch = { item_colour : string; item_size : int }
|
|
[@@fieldglass generate ~field_prefix_from_type]
|
|
end
|
|
|
|
let () =
|
|
assert (Named.swatch_colour Named.{ item_colour = "grey"; item_size = 3 } = "grey");
|
|
assert (Typed.swatch_size Typed.{ item_colour = "grey"; item_size = 3 } = 3)
|
|
|
|
module Verbs = struct
|
|
type t = { colour : string }
|
|
[@@fieldglass generate ~get_prefix:read ~set_prefix:replace ~update_prefix:"revise"]
|
|
end
|
|
|
|
let () =
|
|
let original = Verbs.{ colour = "grey" } in
|
|
assert (Verbs.read_colour original = "grey");
|
|
assert (Verbs.read_colour (Verbs.replace_colour "blue" original) = "blue");
|
|
assert (Verbs.read_colour (Verbs.revise_colour ~f:(fun s -> s ^ "s") original) = "greys");
|
|
assert (Fieldglass.view Verbs._colour original = "grey")
|
|
|
|
module Ordered = struct
|
|
type t = { count : int }
|
|
[@@fieldglass generate ~self_arg_first ~func_named_arg:change]
|
|
end
|
|
|
|
module Positional = struct
|
|
type t = { count : int }
|
|
[@@fieldglass generate ~self_arg_first ~func_no_named_arg]
|
|
end
|
|
|
|
module Last = struct
|
|
type t = { count : int } [@@fieldglass generate ~func_no_named_arg]
|
|
end
|
|
|
|
let () =
|
|
assert (Ordered.set_count Ordered.{ count = 1 } 2 = Ordered.{ count = 2 });
|
|
assert (Ordered.update_count Ordered.{ count = 1 } ~change:succ = Ordered.{ count = 2 });
|
|
assert (Fieldglass.set Ordered._count 2 Ordered.{ count = 1 } = Ordered.{ count = 2 });
|
|
assert (Positional.update_count Positional.{ count = 1 } succ = Positional.{ count = 2 });
|
|
assert (Last.update_count succ Last.{ count = 1 } = Last.{ count = 2 })
|
|
|
|
module Pairs = struct
|
|
type t = { colour : string } [@@fieldglass generate ~just_lens]
|
|
end
|
|
|
|
module Silent = struct
|
|
type t = { colour : string } [@@fieldglass generate ~just_lens ~no_lens]
|
|
end
|
|
|
|
module Functions = struct
|
|
type t = { colour : string } [@@fieldglass generate ~no_lens ~no_get:false]
|
|
end
|
|
|
|
let () =
|
|
assert (Fieldglass.view Pairs._colour Pairs.{ colour = "grey" } = "grey");
|
|
assert (Silent.{ colour = "grey" }.colour = "grey");
|
|
assert (Functions.colour Functions.{ colour = "grey" } = "grey")
|