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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
type t = Yojson.Basic.t
let of_file f : t = Yojson.Basic.from_file f
let of_string s : t = (Yojson.Basic.from_string s :> t)
let float_needs_period s =
try
for i = 0 to String.length s - 1 do
match s.[i] with
| '0'..'9' | '-' -> ()
| _ -> raise Exit
done;
true
with Exit ->
false
let string_of_truncated_float f =
let s = Printf.sprintf "%.3g" f in
if float_needs_period s then s ^ ".0" else s
let rec truncate_floats : Yojson.Basic.t -> Yojson.t = function
| `Int i -> `Intlit (string_of_int i)
| `Float f -> `Floatlit (string_of_truncated_float f)
| `String _ as s -> `Stringlit (Yojson.Basic.to_string s)
| `Assoc fs -> `Assoc (List.map (fun (s, js) -> (s, truncate_floats js)) fs)
| `List js -> `List (List.map truncate_floats js)
| (`Null | `Bool _ as js) -> js
let to_file ?(pretty_floats=false) f js =
let out = open_out f in
let js = if pretty_floats then truncate_floats js else (js :> Yojson.t) in
Yojson.pretty_to_channel ~std:true out js ;
output_char out '\n';
close_out out
let to_string ?(pretty_floats=false) js =
let js = if pretty_floats then truncate_floats js else (js :> Yojson.t) in
Yojson.pretty_to_string ~std:true js
let pp_gen ?(pretty_floats=false) fmt js =
Format.pp_print_string fmt @@ to_string ~pretty_floats js
let pretty = pp_gen ~pretty_floats:true
let print = pp_gen ~pretty_floats:false
let jbool = function
| `Bool b -> b
| _ -> false
let jint = function
| `Int n -> n
| `Float a -> int_of_float (a +. 0.5)
| _ -> 0
let jfloat = function
| `Float a -> a
| `Int n -> float n
| _ -> 0.0
let jstring = function
| `String a -> a
| _ -> ""
let jlist = function
| `List xs -> xs
| _ -> []
let jmap f js = jlist js |> List.map f
let jstringlist js = jlist js |> List.map jstring
let jmem fd = function
| `Assoc fds -> List.mem_assoc fd fds
| _ -> false
let mfield fd = function
| `Assoc fds -> List.mem_assoc fd fds
| _ -> false
let jfield fd = function
| `Assoc fds -> (try List.assoc fd fds with Not_found -> `Null)
| _ -> `Null
let jpath fds js =
List.fold_left (fun js fd -> jfield fd js) js @@
String.split_on_char '/' fds
let joption f = function
| `Null -> None
| js -> Some (f js)
let jdefault value pp = function
| `Null -> value
| js -> pp js
let jfield_exn fd = function
| `Assoc fds -> List.assoc fd fds
| _ -> raise Not_found
let jiter f = function
| `Assoc fds -> List.iter (fun (fd,js) -> f fd js) fds
| _ -> ()
let is_empty = function
| `Null -> true
| `List [] -> true
| `Assoc [] -> true
| _ -> false
let is_nonnull = function `Null -> false | _ -> true
let null = `Null
let int n = `Int n
let bool b = `Bool b
let string s = `String s
let assoc ?(keepnull=false) ?(nullempty=false) fts =
if keepnull then `Assoc fts
else
match List.filter (fun (_,v) -> is_nonnull v) fts with
| [] when nullempty -> `Null
| lts -> `Assoc lts
let list ?(keepnull=false) ?(nullempty=false) js =
if keepnull then `List js
else
match List.filter is_nonnull js with
| [] when nullempty -> `Null
| ls -> `List ls
let option_map f = function None -> `Null | Some a -> f a
let list_map ?(keepnull=false) ?(nullempty=false) f xs =
match
List.filter_map
(fun x -> let v = f x in if keepnull || is_nonnull v then Some v else None)
xs
with [] when nullempty -> `Null | js -> `List js