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
type 'a t = ('a -> unit) -> unit
type 'a input = 'a t
type 'a output = 'a t
type 'a connection = ('a input, unit Sync.output) Connection.t
type 'a connection' = ('a input, unit output) Connection.t
let make f = f
let listen cb stream = stream cb
let pure value cb = cb value
let map f stream cb = stream (fun value -> cb (f value))
let filter f stream cb = stream (fun value -> if f value then cb value)
let scan f init stream =
let acc = ref init in
fun cb ->
stream (fun value ->
acc := f !acc value;
cb !acc)
module type INTERVAL = sig
type interval_id
val set_interval : (unit -> unit) -> int -> interval_id
val clear_interval : interval_id -> unit
end
module Interval (I : INTERVAL) = struct
let forever ~ms =
let i = ref 0 in
fun cb ->
I.set_interval
(fun () ->
i := !i + 1;
cb !i)
ms
|> ignore
let make ~ms =
let i = ref 0 and interval = ref None in
let stream cb =
interval :=
Some
(I.set_interval
(fun () ->
i := !i + 1;
cb !i)
ms)
in
{
Connection.stream;
close =
Sync.make_output (fun () ->
match !interval with
| Some interval' -> I.clear_interval interval'
| _ -> ());
}
end