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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
open Core
module Make_plain (Key : sig
type t [@@deriving sexp_of]
include Comparator.S with type t := t
end) =
struct
module Update = struct
module Diff = struct
type t =
| Remove of Key.t
| Add of Key.t
| Idle of unit
[@@deriving sexp_of]
let idle = Idle ()
end
type t = Diff.t list [@@deriving sexp_of]
end
type t = Set.M(Key).t
let empty = Set.empty (module Key)
let update t diffs =
List.fold diffs ~init:t ~f:(fun t d ->
match (d : Update.Diff.t) with
| Remove key -> Set.remove t key
| Add key -> Set.add t key
| Idle () -> t)
;;
let diffs ~from ~to_ : Update.t =
Set.symmetric_diff from to_
|> Sequence.map ~f:(function
| First k -> Update.Diff.Remove k
| Second k -> Add k)
|> Sequence.to_list
;;
let of_diffs (diffs : Update.t) =
List.fold diffs ~init:empty ~f:(fun t d ->
match d with
| Remove _ -> failwith "Remove is not allowed in of_diffs."
| Add key -> Set.add t key
| Idle () -> t)
;;
let to_diffs (t : t) : Update.t =
let l = Set.to_list t |> List.map ~f:(fun k -> Update.Diff.Add k) in
match l with
| [] -> [ Update.Diff.idle ]
| l -> l
;;
end
module Make (Key : sig
type t [@@deriving sexp, bin_io]
include Comparator.S with type t := t
end) =
struct
module Plain = Make_plain (Key)
module Update = struct
module Diff = struct
type t = Plain.Update.Diff.t =
| Remove of Key.t
| Add of Key.t
| Idle of unit
[@@deriving sexp, bin_io]
end
type t = Diff.t list [@@deriving sexp, bin_io]
end
include (
Plain :
module type of struct
include Plain
end
with module Update := Plain.Update)
end
let%test_module "tests" =
(module struct
module T = struct
module U = struct
type t = int [@@deriving bin_io, compare, equal, sexp]
end
include U
include Comparable.Make (U)
end
include T
include Make (T)
let%test_unit "atomic round-trip works" =
Quickcheck.test
(Quickcheck.Generator.list Int.quickcheck_generator)
~sexp_of:[%sexp_of: int list]
~f:(fun ns ->
let t = T.Set.of_list ns in
[%test_result: T.Set.t] ~expect:t (of_diffs (to_diffs t)))
;;
let%test_unit "atomic diff/update works" =
let open Quickcheck in
Quickcheck.test
(Generator.tuple2
(Quickcheck.Generator.list Int.quickcheck_generator)
(Quickcheck.Generator.list Int.quickcheck_generator))
~sexp_of:[%sexp_of: int list * int list]
~f:(fun (from, to_) ->
let from = T.Set.of_list from in
let to_ = T.Set.of_list to_ in
[%test_result: T.Set.t] ~expect:to_ (update from (diffs ~from ~to_)))
;;
end)
;;