Source file `ag_json.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
85
86
87
88
89
90
91
92
93
(*
  Mapping from ATD to JSON
*)

type json_float = [ `Float of int option (* max decimal places *)
                  | `Int ]

type json_list = [ `Array | `Object ]

type json_variant = { json_cons : string option }

type json_field = {
  json_fname  : string;           (* <json name=...> *)
  json_tag_field : string option; (* <json tag_field=...> *)
  json_unwrapped : bool;
}

type json_record = {
  json_keep_nulls : bool; (* { ... } <json keep_nulls> *)
}

type json_repr =
    [
    | `Unit
    | `Bool
    | `Int
    | `Float of json_float

    | `String
    | `Sum
    | `Record of json_record
    | `Tuple
    | `List of json_list
    | `Option
    | `Nullable
    | `Wrap (* should we add support for Base64 encoding of binary data? *)
    | `External

    | `Cell
    | `Field of json_field
    | `Variant of json_variant
    | `Def
    ]

let json_float_of_string s : [ `Float | `Int ] option =
  match s with
      "float" -> Some `Float
    | "int" -> Some `Int
    | _ -> None

let json_precision_of_string s =
  try Some (Some (int_of_string s))
  with _ -> None

let get_json_precision an =
  Atd_annot.get_field
    json_precision_of_string None ["json"] "precision" an

let get_json_float an : json_float =
  match
    Atd_annot.get_field json_float_of_string `Float ["json"] "repr" an
  with
      `Float -> `Float (get_json_precision an)
    | `Int -> `Int

let json_list_of_string s : json_list option =
  match s with
      "array" -> Some `Array
    | "object" -> Some `Object
    | _ -> None

let get_json_list an =
  Atd_annot.get_field json_list_of_string `Array ["json"] "repr" an

let get_json_cons default an =
  Atd_annot.get_field (fun s -> Some s) default ["json"] "name" an

let get_json_fname default an =
  Atd_annot.get_field (fun s -> Some s) default ["json"] "name" an

let get_json_tag_field an =
  Atd_annot.get_field (fun s -> Some (Some s)) None ["json"] "tag_field" an

let get_json_untyped an =
  Atd_annot.get_flag ["json"] "untyped" an

let get_json_keep_nulls an =
  Atd_annot.get_flag ["json"] "keep_nulls" an

let get_json_record an =
  {
    json_keep_nulls = get_json_keep_nulls an;
  }