package inuit

  1. Overview
  2. Docs

Source file inuit_base.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
module Patch =
struct

  type operation =
    | Remove  of int
    | Insert  of string
    | Replace of int * string
    | Propertize of int

  type 'flags t =
    { offset    : int         (** Starting at [offset]'th unicode sequence *)
    ; operation : operation
    ; text_len  : int
    ; flags     : 'flags list (** A list of backend defined [flags].       *)
    }

  let utf8_length ?(offset=0) str =
    let count = ref 0 in
    for i = offset to String.length str - 1 do
      let c = Char.code str.[i] in
      if c land 0xC0 <> 0x80 then
        incr count
    done;
    !count

  let utf8_offset str ?(offset=0) index =
    let index = ref index and offset = ref offset and len = String.length str in
    while !index > 0 && !offset < len do
      incr offset;
      decr index;
      while !offset < len && (Char.code str.[!offset] land 0xC0 = 0x80) do
        incr offset;
      done;
    done;
    if !index > 0 then raise Not_found;
    !offset

  let make ~offset flags operation = {
    flags = flags; offset = offset; operation;
    text_len = (match operation with
      | Insert text | Replace (_,text) -> utf8_length text
      | _ -> 0
      );
  }

  let with_flags flags t =
    if t.flags == flags then t else {t with flags}

  let removed t = match t.operation with
    | Insert _ | Propertize _ -> 0
    | Remove n | Replace (n,_) -> n

  let inserted t = match t.operation with
    | Insert _ | Replace _ -> t.text_len
    | Propertize _ | Remove _ -> 0

  let inserted_text t = match t.operation with
    | Insert txt | Replace (_,txt) -> txt
    | Propertize _ | Remove _ -> ""
end

type 'flags patch = 'flags Patch.t

module Socket =
struct

  type 'msg t = {
    mutable receive      : 'msg -> unit;
    mutable on_connected : unit -> unit;
    mutable on_closed    : unit -> unit;
    mutable status       : 'msg status;
  }

  and 'msg status =
    | Pending
    | Connected of 'msg t
    | Closed

  type 'a controller = 'a t

  let make ~receive =
    {
      receive      = receive;
      on_connected = ignore;
      on_closed    = ignore;
      status       = Pending;
    }

  let send t msg =
    match t.status with
    | Connected remote ->
      remote.receive msg
    | Pending ->
      invalid_arg "Inuit.Socket.send: sending data to unconnected pipe"
    | Closed ->
      invalid_arg "Inuit.Socket.send: sending data to closed pipe"

  let close t =
    match t.status with
    | Closed -> ()
    | Pending ->
      t.status <- Closed;
      t.on_closed ();
      t.on_connected <- ignore;
      t.receive <- ignore;
      t.on_closed <- ignore;
    | Connected remote ->
      t.status <- Closed;
      remote.status <- Closed;
      t.on_closed ();
      remote.on_closed ();
      t.receive <- ignore;
      t.on_closed <- ignore;
      remote.receive <- ignore;
      remote.on_closed <- ignore

  let connect ~a ~b =
    match a.status, b.status with
    | Pending, Pending ->
      a.status <- Connected b;
      b.status <- Connected a;
      a.on_connected ();
      b.on_connected ();
      a.on_connected <- ignore;
      b.on_connected <- ignore
    | _ ->
      let to_str = function
        | Pending -> "pending"
        | Closed -> "already closed"
        | Connected _ -> "already connected"
      in
      invalid_arg ("Inuit.Socket.connect: pipe a is " ^ to_str a.status ^
                   "and pipe b is " ^ to_str b.status)

  let status t = match t.status with
    | Pending     -> `Pending
    | Connected _ -> `Connected
    | Closed      -> `Closed

  let set_receive t f = t.receive <- f
  let set_on_closed t f = t.on_closed <- f
  let set_on_connected t f = t.on_connected <- f

  let endpoint socket = socket
end

type 'msg socket = 'msg Socket.t
OCaml

Innovation. Community. Security.