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
open! Core
module Make_plain
(S : Legacy_diffable_intf.S_plain) (X : sig
type t
val forwards : S.t -> t
val backwards : t -> S.t
end) =
struct
module Update = S.Update
type t = X.t
let update t diffs = S.update (X.backwards t) diffs |> X.forwards
let diffs ~from ~to_ : Update.t =
S.diffs ~from:(X.backwards from) ~to_:(X.backwards to_)
;;
let to_diffs t = S.to_diffs (X.backwards t)
let of_diffs d = S.of_diffs d |> X.forwards
end
module Make
(S : Legacy_diffable_intf.S) (X : sig
type t
val forwards : S.t -> t
val backwards : t -> S.t
end) =
struct
module Plain = Make_plain (S) (X)
module Update = S.Update
include (
Plain :
module type of struct
include Plain
end
with module Update := Plain.Update)
end
let%test_module "tests" =
(module struct
module Diffable_float = struct
module T = struct
type t = string [@@deriving bin_io, equal, sexp]
end
include T
include Atomic.Make (T)
end
module U = struct
type t = int [@@deriving sexp]
let forwards = Int.of_string
let backwards = Int.to_string
end
include U
include Make (Diffable_float) (U)
let%test_unit "iso round-trip works" =
Quickcheck.test
Int.quickcheck_generator
~shrinker:Int.quickcheck_shrinker
~sexp_of:[%sexp_of: t]
~f:(fun t -> [%test_result: int] ~expect:t (of_diffs (to_diffs t)))
;;
let%test_unit "iso 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: int] ~expect:to_ (update from (diffs ~from ~to_)))
;;
end)
;;