Source file spec.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
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
module type T = sig
  type ('a, 'deser, 'ser) dir
end

module Make(T : T) = struct

  type packed = Packed | Not_packed
  type extension_ranges = (int * int) list
  type extensions = (int * Field.t) list
  type 'a merge = 'a -> 'a -> 'a

  type _ spec =
    | Double : float spec
    | Float : float spec

    | Int32 : Int32.t spec
    | UInt32 : Int32.t spec
    | SInt32 : Int32.t spec
    | Fixed32 : Int32.t spec
    | SFixed32 : Int32.t spec

    | Int32_int : int spec
    | UInt32_int : int spec
    | SInt32_int : int spec
    | Fixed32_int : int spec
    | SFixed32_int : int spec

    | UInt64 : Int64.t spec
    | Int64 : Int64.t spec
    | SInt64 : Int64.t spec
    | Fixed64 : Int64.t spec
    | SFixed64 : Int64.t spec

    | UInt64_int : int spec
    | Int64_int : int spec
    | SInt64_int : int spec
    | Fixed64_int : int spec
    | SFixed64_int : int spec

    | Bool : bool spec
    | String : string spec
    | Bytes : bytes spec
    | Enum :  ('a, int -> 'a, 'a -> int) T.dir -> 'a spec
    | Message : ('a, ((Reader.t -> 'a) * 'a merge), Writer.t -> 'a -> Writer.t) T.dir -> 'a spec

  (* Existential types *)
  type espec = Espec: _ spec -> espec [@@unboxed]

  type _ oneof =
    | Oneof_elem : int * 'b spec * ('a, ('b -> 'a), 'b) T.dir -> 'a oneof

  type _ compound =
    (* A field, where the default value is know (and set). This cannot be used for message types *)
    | Basic : int * 'a spec * 'a -> 'a compound

    (* Proto2/proto3 optional fields. *)
    | Basic_opt : int * 'a spec -> 'a option compound

    (* Proto2 required fields (and oneof fields) *)
    | Basic_req : int * 'a spec -> 'a compound

    (* Repeated fields *)
    | Repeated : int * 'a spec * packed -> 'a list compound
    | Oneof : ('a, 'a oneof list, 'a -> unit oneof) T.dir -> ([> `not_set ] as 'a) compound

  type (_, _) compound_list =
    (* End of list *)
    | Nil : ('a, 'a) compound_list

    (* Nil_ext denotes that the message contains extensions *)
    | Nil_ext: extension_ranges -> (extensions -> 'a, 'a) compound_list

    (* List element *)
    | Cons : ('a compound) * ('b, 'c) compound_list -> ('a -> 'b, 'c) compound_list

  module C = struct
    let double = Double
    let float = Float
    let int32 = Int32
    let int64 = Int64
    let uint32 = UInt32
    let uint64 = UInt64
    let sint32 = SInt32
    let sint64 = SInt64
    let fixed32 = Fixed32
    let fixed64 = Fixed64
    let sfixed32 = SFixed32
    let sfixed64 = SFixed64

    let int32_int = Int32_int
    let int64_int = Int64_int
    let uint32_int = UInt32_int
    let uint64_int = UInt64_int
    let sint32_int = SInt32_int
    let sint64_int = SInt64_int
    let fixed32_int = Fixed32_int
    let fixed64_int = Fixed64_int
    let sfixed32_int = SFixed32_int
    let sfixed64_int = SFixed64_int

    let bool = Bool
    let string = String
    let bytes = Bytes
    let enum f = Enum f
    let message f = Message f

    let some v = Some v
    let none = None
    let default_bytes v = (Some (Bytes.of_string v))

    let repeated (i, s, p) = Repeated (i, s, p)
    let basic (i, s, d) = Basic (i, s, d)
    let basic_req (i, s) = Basic_req (i, s)
    let basic_opt (i, s) = Basic_opt (i, s)
    let oneof s = Oneof s
    let oneof_elem (a, b, c) = Oneof_elem (a, b, c)

    let packed = Packed
    let not_packed = Not_packed

    let ( ^:: ) a b = Cons (a, b)
    let nil = Nil
    let nil_ext extension_ranges = Nil_ext extension_ranges

    let show: type a. a spec -> string = function
      | Double -> "Double"
      | Float -> "Float"

      | Int32 -> "Int32"
      | UInt32 -> "UInt32"
      | SInt32 -> "SInt32"
      | Fixed32 -> "Fixed32"
      | SFixed32 -> "SFixed32"

      | Int32_int -> "Int32_int"
      | UInt32_int -> "UInt32_int"
      | SInt32_int -> "SInt32_int"
      | Fixed32_int -> "Fixed32_int"
      | SFixed32_int -> "SFixed32_int"

      | UInt64 -> "UInt64"
      | Int64 -> "Int64"
      | SInt64 -> "SInt64"
      | Fixed64 -> "Fixed64"
      | SFixed64 -> "SFixed64"

      | UInt64_int -> "UInt64_int"
      | Int64_int -> "Int64_int"
      | SInt64_int -> "SInt64_int"
      | Fixed64_int -> "Fixed64_int"
      | SFixed64_int -> "SFixed64_int"

      | Bool -> "Bool"
      | String -> "String"
      | Bytes -> "Bytes"
      | Enum _ -> "Enum"
      | Message _ -> "Message"
  end
end

module Deserialize = Make(struct
    type ('a, 'deser, 'ser) dir = 'deser
  end)

module Serialize = Make(struct
    type ('a, 'deser, 'ser) dir = 'ser
  end)