1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
open Core
module Make_plain (V : sig
type t [@@deriving sexp_of]
val equal : t -> t -> bool
end) =
struct
module Update = struct
module Diff = struct
type t = V.t [@@deriving sexp_of]
end
type t = Diff.t list [@@deriving sexp_of]
end
type t = V.t
let update t d =
match d with
| [] -> t
| [ t' ] -> t'
| _ :: non_empty_tail -> List.last_exn non_empty_tail
;;
let diffs ~from ~to_ = if phys_equal from to_ || V.equal from to_ then [] else [ to_ ]
let to_diffs t = [ t ]
let of_diffs d =
match d with
| [ t ] -> t
| _ :: non_empty_tail -> List.last_exn non_empty_tail
| [] ->
failwith
"Invalid of_diffs input. Update.t for atomic must contain at least one element."
;;
end
module Make (V : sig
type t [@@deriving bin_io, sexp]
val equal : t -> t -> bool
end) =
struct
module Plain = Make_plain (V)
module Update = struct
module Diff = struct
include Plain.Update.Diff
include (
V :
sig
type t [@@deriving bin_io, sexp]
end
with type t := t)
end
type t = Diff.t list [@@deriving bin_io, sexp]
end
include (
Plain :
module type of struct
include Plain
end
with module Update := Plain.Update)
end
module%test [@name "tests"] _ = struct
module T = struct
type t = int [@@deriving bin_io, equal, sexp]
end
include T
include Make (T)
let%test_unit "atomic round-trip works" =
Quickcheck.test
Int.quickcheck_generator
~shrinker:Int.quickcheck_shrinker
~sexp_of:[%sexp_of: t]
~f:(fun t -> [%test_result: t] ~expect:t (of_diffs (to_diffs t)))
;;
let%test_unit "atomic diff/update works" =
let open Quickcheck in
Quickcheck.test
(Generator.tuple2 Int.quickcheck_generator Int.quickcheck_generator)
~shrinker:(Shrinker.tuple2 Int.quickcheck_shrinker Int.quickcheck_shrinker)
~sexp_of:[%sexp_of: t * t]
~f:(fun (from, to_) ->
[%test_result: t] ~expect:to_ (update from (diffs ~from ~to_)))
;;
end