Source file field.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
type length_delimited = {
  offset : int;
  length : int;
  data : string;
}

type field_type = Varint | Fixed64 | Fixed32 | Length_delimited

type t =
  | Varint of Int64.t (* int32, int64, uint32, uint64, sint32, sint64, bool, enum *)
  | Varint_unboxed of int
  | Fixed_64_bit of Int64.t (* fixed64, sfixed64, double *)
  | Length_delimited of length_delimited (* string, bytes, embedded messages, packed repeated fields *)
  | Fixed_32_bit of Int32.t (* fixed32, sfixed32, float *)

let varint v = Varint v
let varint_unboxed v = Varint_unboxed v
let fixed_32_bit v = Fixed_32_bit v
let fixed_64_bit v = Fixed_64_bit v
let length_delimited ?(offset=0) ?length data =
  let length = Option.value ~default:(String.length data - offset) length in
  Length_delimited {offset; length; data}

let string_of_field_type: field_type -> string = function
  | Varint -> "Varint"
  | Fixed64 -> "Fixed64"
  | Length_delimited -> "Length_delimited"
  | Fixed32 -> "Fixed32"

let pp: Format.formatter -> t -> unit = fun fmt ->
  function
  | Varint_unboxed a0 ->
    (Format.fprintf fmt "(@[<2>Field.Varint_unboxed@ ";
     (Format.fprintf fmt "%d") a0;
     Format.fprintf fmt "@])")
  | Varint a0 ->
    (Format.fprintf fmt "(@[<2>Field.Varint@ ";
     (Format.fprintf fmt "%LdL") a0;
     Format.fprintf fmt "@])")
  | Fixed_64_bit a0 ->
    (Format.fprintf fmt
       "(@[<2>Field.Fixed_64_bit@ ";
     (Format.fprintf fmt "%LdL") a0;
     Format.fprintf fmt "@])")
  | Length_delimited
      { offset = aoffset; length = alength; data = adata } ->
    (Format.fprintf fmt
       "@[<2>Field.Length_delimited {@,";
     (((Format.fprintf fmt "@[%s =@ " "offset";
        (Format.fprintf fmt "%d") aoffset;
        Format.fprintf fmt "@]");
       Format.fprintf fmt ";@ ";
       Format.fprintf fmt "@[%s =@ " "length";
       (Format.fprintf fmt "%d") alength;
       Format.fprintf fmt "@]");
      Format.fprintf fmt ";@ ";
      Format.fprintf fmt "@[%s =@ " "data";
      (match alength < 20 with
       | true -> (Format.fprintf fmt "%S") (String.sub adata aoffset alength)
       | false -> (Format.fprintf fmt "%S...") (String.sub adata aoffset 17)
      );
      Format.fprintf fmt "@]");
     Format.fprintf fmt "@]}")
  | Fixed_32_bit a0 ->
    (Format.fprintf fmt
       "(@[<2>Field.Fixed_32_bit@ ";
     (Format.fprintf fmt "%ldl") a0;
     Format.fprintf fmt "@])")

let show : t -> string = Format.asprintf "%a" pp