Source file `pbrt_yojson.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
module E = struct
  type error =
    | Unexpected_json_type of string * string
    | Malformed_variant of string

  exception Failure of error

  let unexpected_json_type record_name field_name =
    raise (Failure (Unexpected_json_type (record_name, field_name)))

  let malformed_variant variant_name =
    raise (Failure (Malformed_variant variant_name))

  let string_of_error = function
    | Unexpected_json_type (record_name, field_name) ->
      Printf.sprintf "Unexpected json type (record name:%s, field_name:%s)"
        record_name field_name
    | Malformed_variant variant_name ->
      Printf.sprintf "Malformed variant (variant name: %s)" variant_name

  let () =
    Printexc.register_printer (fun exn ->
        match exn with
        | Failure e -> Some (string_of_error e)
        | _ -> None)
end

let int32 v record_name field_name =
  match v with
  | `String v -> Int32.of_string v
  | `Float f -> Int32.of_float f
  | `Int i -> Int32.of_int i
  | `Null -> 0l
  | _ -> E.unexpected_json_type record_name field_name

let float v record_name field_name =
  match v with
  | `String v -> float_of_string v
  | `Float f -> f
  | `Int i -> float_of_int i
  | `Null -> 0.0
  | _ -> E.unexpected_json_type record_name field_name

let int64 v record_name field_name =
  match v with
  | `String v -> Int64.of_string v
  | `Float f -> Int64.of_float f
  | `Int i -> Int64.of_int i
  | `Null -> 0L
  | _ -> E.unexpected_json_type record_name field_name

let int v record_name field_name =
  match v with
  | `String v -> int_of_string v
  | `Float f -> int_of_float f
  | `Int i -> i
  | `Null -> 0
  | _ -> E.unexpected_json_type record_name field_name

let string v record_name field_name =
  match v with
  | `String v -> v
  | `Null -> ""
  | _ -> E.unexpected_json_type record_name field_name

let bool v record_name field_name =
  match v with
  | `Bool b -> b
  | `Null -> false
  | _ -> E.unexpected_json_type record_name field_name

let bytes v record_name field_name =
  string v record_name field_name |> Base64.decode_exn |> Bytes.of_string

let unit v record_name field_name =
  match v with
  | `Assoc [] -> ()
  | _ -> E.unexpected_json_type record_name field_name

let make_bool v = `Bool v
let make_int v = `Int v
let make_float v = `Float v
let make_string v = `String v

let make_bytes s =
  make_string (s |> Bytes.to_string |> Base64.encode_exn ~pad:true)

let make_unit () = `Assoc []
let make_list v = `List v