1type json =
2 | Null
3 | Bool of bool
4 | Int of int
5 | Float of float
6 | String of string
7 | Array of json list
8 | Object of (string * json) list
9
10let rec to_string = function
11 | Null -> "null"
12 | Bool b -> string_of_bool b
13 | Int n -> string_of_int n
14 | Float f -> Printf.sprintf "%g" f
15 | String s -> Printf.sprintf "\"%s\"" s
16 | Array items ->
17 let inner =
18 items
19 |> List.map to_string
20 |> String.concat ", "
21 in
22 Printf.sprintf "[%s]" inner
23 | Object pairs ->
24 let inner =
25 pairs
26 |> List.map (fun (k, v) ->
27 Printf.sprintf "\"%s\": %s" k (to_string v))
28 |> String.concat ", "
29 in
30 Printf.sprintf "{%s}" inner
31
32let rec get_path json path =
33 match json, path with
34 | _, [] -> Some json
35 | Object pairs, key :: rest ->
36 (match List.assoc_opt key pairs with
37 | Some child -> get_path child rest
38 | None -> None)
39 | Array items, idx :: rest ->
40 (match int_of_string_opt idx with
41 | Some i when i >= 0 && i < List.length items ->
42 get_path (List.nth items i) rest
43 | _ -> None)
44 | _ -> None
45
46let rec map_strings f = function
47 | String s -> String (f s)
48 | Array items -> Array (List.map (map_strings f) items)
49 | Object pairs ->
50 Object (List.map (fun (k, v) -> (k, map_strings f v)) pairs)
51 | other -> other
52
53let rec fold_values f acc = function
54 | Array items ->
55 List.fold_left (fold_values f) acc items
56 | Object pairs ->
57 List.fold_left (fun a (_, v) -> fold_values f a v) acc pairs
58 | value -> f acc value
59
60let count_strings json =
61 fold_values
62 (fun count v ->
63 match v with String _ -> count + 1 | _ -> count)
64 0 json
65
66let merge a b =
67 match a, b with
68 | Object pa, Object pb ->
69 let merged =
70 List.fold_left
71 (fun acc (k, v) ->
72 if List.mem_assoc k acc then acc
73 else (k, v) :: acc)
74 pa pb
75 in
76 Object merged
77 | _ -> b