package diffable

  1. Overview
  2. Docs

Source file option.ml

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
126
open Core

module Make_plain (X : sig
    type t

    include Diffable_intf.S_plain with type t := t
  end) =
struct
  module Update = struct
    module Diff = struct
      type t =
        | Change of X.Update.Diff.t
        | Set_to_none
        | Idle
      [@@deriving sexp_of]
    end

    type t = Diff.t list [@@deriving sexp_of]
  end

  type t = X.t option

  let update t (diffs : Update.t) =
    Sequence.of_list diffs
    |> Sequence.group ~break:(fun l r ->
      match l, r with
      | Change _, Change _ -> false
      | _ -> true)
    |> Sequence.fold ~init:t ~f:(fun t change ->
      match change with
      | [ Idle ] -> t
      | [ Set_to_none ] -> None
      | Change _ :: _ as diffs ->
        let diffs =
          List.map diffs ~f:(function
            | Idle | Set_to_none -> failwith "BUG: Hit impossible case"
            | Change x -> x)
        in
        (match t with
         | None -> Some (X.of_diffs diffs)
         | Some t -> Some (X.update t diffs))
      | _ -> failwith "BUG: Hit impossible case")
  ;;

  let diffs ~from ~to_ : Update.t =
    match from, to_ with
    | None, None -> [ Idle ]
    | Some _, None -> [ Set_to_none ]
    | None, Some to_ -> List.map (X.to_diffs to_) ~f:(fun diff -> Update.Diff.Change diff)
    | Some from, Some to_ ->
      List.map (X.diffs ~from ~to_) ~f:(fun diff -> Update.Diff.Change diff)
  ;;

  let of_diffs = update None
  let to_diffs t = diffs ~from:None ~to_:t
end

module Make (X : sig
    type t

    include Diffable_intf.S with type t := t
  end) =
struct
  module Plain = Make_plain (X)

  module Update = struct
    module Diff = struct
      type t = Plain.Update.Diff.t =
        | Change of X.Update.Diff.t
        | Set_to_none
        | Idle
      [@@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 "diffable option" =
  (module struct
    module X = Atomic.Make (Int)
    module O = Make (X)
    module O2 = Make (O)

    let test1 ~one ~two =
      [%test_result: int option] (O.of_diffs (O.to_diffs one)) ~expect:one;
      [%test_result: int option] (O.of_diffs (O.to_diffs two)) ~expect:two;
      [%test_result: int option] (O.update one (O.diffs ~from:one ~to_:two)) ~expect:two;
      [%test_result: int option] (O.update two (O.diffs ~from:two ~to_:one)) ~expect:one
    ;;

    let test2 ~one ~two =
      [%test_result: int option option] (O2.of_diffs (O2.to_diffs one)) ~expect:one;
      [%test_result: int option option] (O2.of_diffs (O2.to_diffs two)) ~expect:two;
      [%test_result: int option option]
        (O2.update one (O2.diffs ~from:one ~to_:two))
        ~expect:two;
      [%test_result: int option option]
        (O2.update two (O2.diffs ~from:two ~to_:one))
        ~expect:one
    ;;

    let%test_unit "diffs" =
      test1 ~one:None ~two:None;
      test1 ~one:None ~two:(Some 23);
      test1 ~one:(Some 23) ~two:None;
      test1 ~one:(Some 23) ~two:(Some 42);
      test2 ~one:None ~two:None;
      test2 ~one:None ~two:(Some None);
      test2 ~one:None ~two:(Some (Some 23));
      test2 ~one:(Some None) ~two:None;
      test2 ~one:(Some None) ~two:(Some None);
      test2 ~one:(Some None) ~two:(Some (Some 23));
      test2 ~one:(Some (Some 23)) ~two:None;
      test2 ~one:(Some (Some 23)) ~two:(Some None);
      test2 ~one:(Some (Some 23)) ~two:(Some (Some 23))
    ;;
  end)
;;