package atacama

  1. Overview
  2. Docs

Source file handler.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
open Riot

module rec R : sig
  type t =
    | H : {
        handler :
          (module R.Intf with type state = 'new_state and type error = 'error);
        state : 'new_state;
      }
        -> t

  type ('state, 'error) handler_result =
    | Ok
    | Continue of 'state
    | Continue_with_timeout of 'state * Timeout.t
    | Close of 'state
    | Error of 'state * 'error
    | Switch of t

  module type Intf = sig
    type state
    type error

    val pp_err : Format.formatter -> error -> unit
    val handle_close : Connection.t -> state -> unit

    val handle_connection :
      Connection.t -> state -> (state, error) handler_result

    val handle_data :
      Bytestring.t -> Connection.t -> state -> (state, error) handler_result

    val handle_error :
      error -> Connection.t -> state -> (state, error) handler_result

    val handle_shutdown : Connection.t -> state -> (state, error) handler_result
    val handle_timeout : Connection.t -> state -> (state, error) handler_result

    val handle_message :
      Message.t -> Connection.t -> state -> (state, error) handler_result
  end
end = struct
  type t =
    | H : {
        handler :
          (module R.Intf with type state = 'new_state and type error = 'error);
        state : 'new_state;
      }
        -> t

  type ('state, 'error) handler_result =
    | Ok
    | Continue of 'state
    | Continue_with_timeout of 'state * Timeout.t
    | Close of 'state
    | Error of 'state * 'error
    | Switch of t

  module type Intf = sig
    type state
    type error

    val pp_err : Format.formatter -> error -> unit
    val handle_close : Connection.t -> state -> unit

    val handle_connection :
      Connection.t -> state -> (state, error) handler_result

    val handle_data :
      Bytestring.t -> Connection.t -> state -> (state, error) handler_result

    val handle_error :
      error -> Connection.t -> state -> (state, error) handler_result

    val handle_shutdown : Connection.t -> state -> (state, error) handler_result
    val handle_timeout : Connection.t -> state -> (state, error) handler_result

    val handle_message :
      Message.t -> Connection.t -> state -> (state, error) handler_result
  end
end

include R

module Default = struct
  let pp_err _fmt _err = ()
  let handle_close _sock _state = ()
  let handle_connection _sock state = Continue state
  let handle_data _data _sock state = Continue state
  let handle_error err _sock state = Error (state, err)
  let handle_shutdown _sock _state = Ok
  let handle_timeout _sock _state = Ok
  let handle_message _msg _conn state = Continue state
end

let pp_err (type s e) (module H : Intf with type state = s and type error = e)
    fmt (e : e) =
  H.pp_err fmt e

let handle_close (type s e)
    (module H : Intf with type state = s and type error = e) sock (state : s) =
  H.handle_close sock state

let handle_connection (type s e)
    (module H : Intf with type state = s and type error = e) sock (state : s) =
  H.handle_connection sock state

let handle_data (type s e)
    (module H : Intf with type state = s and type error = e) data sock
    (state : s) =
  H.handle_data data sock state

let handle_message (type s e)
    (module H : Intf with type state = s and type error = e) data conn
    (state : s) =
  H.handle_message data conn state