crdt library in ocaml implementing json-joy
1(** JSON codec for Patch (verbose format).
2
3 Encodes/decodes patches in the json-joy verbose JSON format:
4 {[
5 {"id": [sid, time], "ops": [...operations...
6 ]}
7
8 This matches the format in patches.verbose.json conformance traces. *)
9
10module J = Simdjsont.Json
11
12let encode_patch_json (patch : Patch.t) : J.t =
13 let id_json =
14 J.Array
15 [
16 J.Float (Float.of_int patch.id.sid);
17 J.Float (Float.of_int patch.id.time);
18 ]
19 in
20 let ops_json = J.Array (List.map Op_codec.encode_op patch.ops) in
21 J.Object [ ("id", id_json); ("ops", ops_json) ]
22
23let encode (patch : Patch.t) : string =
24 let json = encode_patch_json patch in
25 J.to_string json
26
27let encode_pretty (patch : Patch.t) : string =
28 let json = encode_patch_json patch in
29 J.to_string json
30
31let get_member key (mems : (string * J.t) list) : J.t option =
32 List.find_map (fun (k, v) -> if k = key then Some v else None) mems
33
34let decode_patch_json (json : J.t) : (Patch.t, string) result =
35 match json with
36 | J.Object mems -> (
37 match get_member "id" mems with
38 | None -> Error "missing 'id' field"
39 | Some id_json -> (
40 match id_json with
41 | J.Array [ J.Float sid; J.Float time ] -> (
42 let id : Clock.timestamp =
43 { sid = Float.to_int sid; time = Float.to_int time }
44 in
45 match get_member "ops" mems with
46 | None -> Error "missing 'ops' field"
47 | Some (J.Array ops_json) -> (
48 let rec decode_ops acc = function
49 | [] -> Ok (List.rev acc)
50 | op_json :: rest -> (
51 match Op_codec.decode_op op_json with
52 | Ok op -> decode_ops (op :: acc) rest
53 | Error e -> Error e)
54 in
55 match decode_ops [] ops_json with
56 | Ok ops -> Ok (Patch.create ~id ~ops)
57 | Error e -> Error e)
58 | Some _ -> Error "'ops' field must be an array")
59 | J.Array [ J.Int sid; J.Int time ] -> (
60 let id : Clock.timestamp =
61 { sid = Int64.to_int sid; time = Int64.to_int time }
62 in
63 match get_member "ops" mems with
64 | None -> Error "missing 'ops' field"
65 | Some (J.Array ops_json) -> (
66 let rec decode_ops acc = function
67 | [] -> Ok (List.rev acc)
68 | op_json :: rest -> (
69 match Op_codec.decode_op op_json with
70 | Ok op -> decode_ops (op :: acc) rest
71 | Error e -> Error e)
72 in
73 match decode_ops [] ops_json with
74 | Ok ops -> Ok (Patch.create ~id ~ops)
75 | Error e -> Error e)
76 | Some _ -> Error "'ops' field must be an array")
77 | _ -> Error "'id' field must be [sid, time] array"))
78 | _ -> Error "expected JSON object"
79
80let decode (s : string) : (Patch.t, string) result =
81 match Simdjsont.Decode.decode_string Simdjsont.Decode.value s with
82 | Ok json -> decode_patch_json json
83 | Error e -> Error (Printf.sprintf "JSON parse error: %s" e)
84
85let encode_batch_json (batch : Patch.batch) : J.t =
86 J.Array (List.map encode_patch_json batch)
87
88let encode_batch (batch : Patch.batch) : string =
89 let json = encode_batch_json batch in
90 J.to_string json
91
92let decode_batch_json (json : J.t) : (Patch.batch, string) result =
93 match json with
94 | J.Array patches_json ->
95 let rec decode_patches acc = function
96 | [] -> Ok (List.rev acc)
97 | patch_json :: rest -> (
98 match decode_patch_json patch_json with
99 | Ok patch -> decode_patches (patch :: acc) rest
100 | Error e -> Error e)
101 in
102 decode_patches [] patches_json
103 | _ -> Error "expected JSON array of patches"
104
105let decode_batch (s : string) : (Patch.batch, string) result =
106 match Simdjsont.Decode.decode_string Simdjsont.Decode.value s with
107 | Ok json -> decode_batch_json json
108 | Error e -> Error (Printf.sprintf "JSON parse error: %s" e)