Source file de.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
include Error
module Deserializer = Deserializer
module Error = Error
module Impls = Impls
module Reader = Reader
module Unimplemented = Unimplemented
module Visitor = Visitor

module Sequence_access = Sequence_access
(** Access modules *)

module Variant_access = Variant_access
module Map_access = Map_access

module type Base = Intf.Deserializer_base_intf
module type Deserializer = Intf.Deserializer_intf

module type Factory = sig
  type state

  val make : state -> state Deserializer.t
end

module Make (B : Base) : Factory with type state = B.state = struct
  type state = B.state

  let make state =
    let module D = struct
      include B

      let state = state
    end in
    (module D : Deserializer with type state = B.state)
end

(** boilerplace below is because we don't have modular implicits yet.
    
    it threads the two modules manually, and makes sure the all the types are
    escaping correctly.
*)

let deserialize_unit :
    type value state.
    state Deserializer.t -> value Visitor.t -> (value, 'error de_error) result =
 fun (module De) (module V) ->
  match De.deserialize_unit De.state (module De) (module V) with
  | exception e -> Error.unexpected_exception e
  | res -> res

let deserialize_string :
    type value state.
    state Deserializer.t -> value Visitor.t -> (value, 'error de_error) result =
 fun (module De) (module V) ->
  match De.deserialize_string De.state (module De) (module V) with
  | exception e -> Error.unexpected_exception e
  | res -> res

let deserialize_int :
    type value state.
    state Deserializer.t -> value Visitor.t -> (value, 'error de_error) result =
 fun (module De) (module V) ->
  match De.deserialize_int De.state (module De) (module V) with
  | exception e -> Error.unexpected_exception e
  | res -> res

let deserialize_bool :
    type value state.
    state Deserializer.t -> value Visitor.t -> (value, 'error de_error) result =
 fun (module De) (module V) ->
  match De.deserialize_bool De.state (module De) (module V) with
  | exception e -> Error.unexpected_exception e
  | res -> res

let deserialize_identifier :
    type value state.
    state Deserializer.t -> value Visitor.t -> (value, 'error de_error) result =
 fun (module De) (module V) ->
  match De.deserialize_identifier De.state (module De) (module V) with
  | exception e -> Error.unexpected_exception e
  | res -> res

let deserialize_record :
    type value field state.
    state Deserializer.t ->
    (value, field) Visitor.with_tag ->
    field Visitor.t ->
    name:string ->
    fields:string list ->
    (value, 'error de_error) result =
 fun (module De) (module Value) (module Field) ~name ~fields ->
  match
    De.deserialize_record De.state
      (module De)
      (module Value)
      (module Field)
      ~name ~fields
  with
  | exception e -> Error.unexpected_exception e
  | res -> res

let deserialize_seq :
    type value state.
    state Deserializer.t -> value Visitor.t -> (value, 'error de_error) result =
 fun (module De) (module V) ->
  match De.deserialize_seq De.state (module De) (module V) with
  | exception e -> Error.unexpected_exception e
  | res -> res

let deserialize_variant :
    type value tag state.
    state Deserializer.t ->
    (value, tag) Visitor.with_tag ->
    tag Visitor.t ->
    name:string ->
    variants:string list ->
    (value, 'error de_error) result =
 fun (module De) (module Value) (module Variant) ~name ~variants ->
  match
    De.deserialize_variant De.state
      (module De)
      (module Value)
      (module Variant)
      ~name ~variants
  with
  | exception e -> Error.unexpected_exception e
  | res -> res