Source file base.ml
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
type (_, _) eq = Eq : ('a, 'a) eq
module Type = struct
type 'a t =
| Float : float t
| String : string t
| Array : 'a t -> 'a array t
type type_ = Type : 'a t -> type_
let rec eq : type a b . a t -> b t -> (a, b) eq option = fun a b ->
match a, b with
| Float, Float -> Some Eq
| String, String -> Some Eq
| Array a, Array b ->
(match eq a b with
| Some Eq -> Some Eq
| _ -> None)
| _ -> None
let _eq = eq
end
module Value = struct
type 'a t = 'a Type.t * 'a
type value = Value : 'a t -> value
let float f : float t = Type.Float, f
let string s : string t = Type.String, s
let array ty vs : 'a array t = Type.Array ty, vs
let rec to_json v : Ezjsonm.value =
match v with
| Value (Type.Float, f) -> `Float f
| Value (String, s) -> `String s
| Value (Array ty, xs) -> `A (List.map (fun x -> to_json (Value (ty, x))) @@ Array.to_list xs)
let rec of_json v =
let open Option in
match v with
| `Float f -> Some (Value (float f))
| `String s -> Some (Value (string s))
| `A vs ->
let* vs = mapM of_json vs in
(match vs with
| [] -> None
| v::vs ->
let Value (ty, _) = v in
let rec check acc = function
| [] -> Some (Value (Type.Array ty, Array.of_list @@ List.rev acc))
| v'::vs ->
let Value (ty', v') = v' in
match Type.eq ty ty' with
| Some Eq -> check (v'::acc) vs
| None -> None
in
check [] (v::vs))
| _ -> None
end
module Attribute = struct
type t = string * Value.value
end
module Attributes = struct
type t = Attribute.t list
open Value
let float n f = [n, Value (Value.float f)]
let string n s = [n, Value (Value.string s)]
let array n ty vs = [n, Value (Value.array ty vs)]
let to_json xs =
`O (List.map (fun (k, v) -> k, Value.to_json v) xs)
let of_json j =
let open Option in
match j with
| `O kvs ->
Option.mapM (fun (k, v) ->
let+ res = Value.of_json v in
(k, res)) kvs
| _ -> None
end