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
|
(** This module defines various basic utilities for json deserialization.
*)
open Yojson.Basic
type json = t
let ( let* ) o f = match o with Error e -> Error e | Ok x -> f x
let combine_error_msgs js msg res : ('a, string) result =
match res with
| Ok x -> Ok x
| Error e -> Error (msg ^ " failed on: " ^ show js ^ "\n" ^ e)
let bool_of_json (js : json) : (bool, string) result =
match js with
| `Bool b -> Ok b
| _ -> Error ("bool_of_json: not a bool: " ^ show js)
let int_of_json (js : json) : (int, string) result =
match js with
| `Int i -> Ok i
| _ -> Error ("int_of_json: not an int: " ^ show js)
let char_of_json (js : json) : (char, string) result =
match js with
| `String c ->
if String.length c == 1 then Ok c.[0]
else Error ("char_of_json: stricly more than one character in: " ^ show js)
| _ -> Error ("char_of_json: not a char: " ^ show js)
let rec of_json_list (a_of_json : json -> ('a, string) result) (jsl : json list)
: ('a list, string) result =
match jsl with
| [] -> Ok []
| x :: jsl' ->
let* x = a_of_json x in
let* jsl' = of_json_list a_of_json jsl' in
Ok (x :: jsl')
let pair_of_json (a_of_json : json -> ('a, string) result)
(b_of_json : json -> ('b, string) result) (js : json) :
('a * 'b, string) result =
match js with
| `List [ a; b ] ->
let* a = a_of_json a in
let* b = b_of_json b in
Ok (a, b)
| _ -> Error ("pair_of_json failed on: " ^ show js)
let list_of_json (a_of_json : json -> ('a, string) result) (js : json) :
('a list, string) result =
combine_error_msgs js "list_of_json"
(match js with
| `List jsl -> of_json_list a_of_json jsl
| _ -> Error ("not a list: " ^ show js))
let string_of_json (js : json) : (string, string) result =
match js with
| `String str -> Ok str
| _ -> Error ("string_of_json: not a string: " ^ show js)
let option_of_json (a_of_json : json -> ('a, string) result) (js : json) :
('a option, string) result =
combine_error_msgs js "option_of_json"
(match js with
| `Null -> Ok None
| _ ->
let* x = a_of_json js in
Ok (Some x))
let string_option_of_json (js : json) : (string option, string) result =
combine_error_msgs js "string_option_of_json"
(option_of_json string_of_json js)
|
