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
open Js_of_ocaml
type ('a, 'b) kind =
| Leaf of 'b
| Arr of 'a list
| Obj of (string * 'a) list
type ('a, 'b) zip =
| LeafVal of 'b
| KeyVal of string
| LeafZip of 'a
| ArrZip of 'b list * 'a list
| ObjZip of (string * 'b) list * (string * 'a) list
module type Converter = sig
type 'a _from
type _to
val kind_of : 'a _from -> ('a _from, _to) kind
val arr : _to list -> _to
val obj : (string * _to) list -> _to
end
module Js_to_JSON_Converter : Converter with type _ _from = Js.Unsafe.any
and type _to = Json_repr.ezjsonm
= struct
type _ _from = Js.Unsafe.any
type _to = Json_repr.ezjsonm
let arr l = `A l
let obj l = `O l
external js_equals : 'a -> 'b -> bool = "caml_js_equals"
let null = Js.Unsafe.pure_js_expr "null"
let kind_of j =
if js_equals j null then Leaf (`Null)
else
match Js.to_string (Js.typeof j) with
| "object" ->
if Js.to_bool (Js.Unsafe.global##._Array##isArray j) then (
Arr
(Array.to_list
(Js.to_array (Js.Unsafe.coerce j : 'a Js.js_array Js.t))))
else (
let keys = Array.to_list (Js.to_array (Js.object_keys j)) in
let l =
List.map (fun k -> Js.to_string k, Js.Unsafe.get j k) keys in
Obj l)
| "string" ->
Leaf (`String
(Js.to_string (Js.Unsafe.coerce j : Js.js_string Js.t)))
| "number" ->
Leaf (`Float
(Js.float_of_number (Js.Unsafe.coerce j : Js.number Js.t)))
| "boolean" ->
Leaf (`Bool (Js.to_bool (Js.Unsafe.coerce j : bool Js.t)))
| tof -> raise (Invalid_argument ("json_of_js: "^tof))
end
module JSON_to_Js_Converter : Converter with type 'a _from = Json_repr.ezjsonm
and type _to = Js.Unsafe.any
= struct
type 'a _from = Json_repr.ezjsonm
type _to = Js.Unsafe.any
let arr l = Js.array (Array.of_list l) |> Js.Unsafe.inject
let obj l = Js.Unsafe.obj (Array.of_list l) |> Js.Unsafe.inject
let kind_of = function
| `Null -> Leaf (Js.Unsafe.inject Js.null)
| `Bool b -> Leaf (Js.Unsafe.inject (Js.bool b))
| `Float f -> Leaf (Js.Unsafe.inject (Js.number_of_float f))
| `String s -> Leaf (Js.Unsafe.inject (Js.string s))
| `A l -> Arr l
| `O kl -> Obj kl
end
module Make_Conv (C : Converter) : sig
val convert : ('a C._from, C._to) zip list -> C._to
end = struct
let rec convert = function
| [LeafVal v] -> v
| LeafZip j :: stack ->
begin match C.kind_of j with
| Leaf leaf -> convert (LeafVal leaf :: stack)
| Arr [] -> convert (LeafVal (C.arr []) :: stack)
| Obj [] -> convert (LeafVal (C.obj []) :: stack)
| Arr (j :: l) -> convert (LeafZip j :: ArrZip ([], l) :: stack)
| Obj ((k, j) :: kl) ->
convert (LeafZip j :: KeyVal k :: ObjZip ([], kl) :: stack)
end
| LeafVal v :: ArrZip (ez_revlist, []) :: stack ->
convert (LeafVal (C.arr (List.rev (v :: ez_revlist))) :: stack)
| LeafVal v :: KeyVal k :: ObjZip (ez_revlist, []) :: stack ->
convert (LeafVal (C.obj (List.rev ((k, v) :: ez_revlist))) :: stack)
| LeafVal v :: ArrZip (ez_revlist, j :: js_list) :: stack ->
convert (LeafZip j :: ArrZip (v :: ez_revlist, js_list) :: stack)
| LeafVal v :: KeyVal k1 ::
ObjZip (ez_revlist, (k2, j) :: js_list) :: stack ->
convert (LeafZip j :: KeyVal k2 ::
ObjZip ((k1, v) :: ez_revlist, js_list) :: stack)
| []
| (LeafVal _ | KeyVal _ | ArrZip _ | ObjZip _) :: _ -> assert false
end
module Js_to_JSON = Make_Conv (Js_to_JSON_Converter)
module JSON_to_Js = Make_Conv (JSON_to_Js_Converter)
let json_of_js j = Js_to_JSON.convert [LeafZip j]
let js_of_json j = JSON_to_Js.convert [LeafZip j]