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
open Fmlib_js
type 'm t =
| None
| Task of ('m, Task.empty) Task.t
| Task_wo_message of (unit, Task.empty) Task.t
| Batch of 'm t list
let none: 'm t =
None
let batch (lst: 'm t list): 'm t =
Batch lst
let perform (task: ('a, Task.empty) Task.t): 'm t =
Task task
let just_do (task: (unit, Task.empty) Task.t): 'm t =
Task_wo_message task
let attempt (f: ('a, 'e) result -> 'm) (task: ('a, 'e) Task.t): 'm t =
Task (Task.make_succeed f task)
let map (f: 'a -> 'b) (cmd: 'a t): 'b t =
let rec map = function
| None ->
None
| Task task ->
Task (Task.map f task)
| Task_wo_message _ as cmd ->
cmd
| Batch lst ->
Batch (List.map map lst)
in
map cmd
let execute (post: Base.Value.t -> unit) (dispatch: 'm -> unit) (cmd: 'm t): unit =
let rec exe = function
| None ->
()
| Task task ->
Task.run task post dispatch
| Task_wo_message task ->
Task.run task post (fun _ -> ())
| Batch lst ->
List.iter exe lst
in
exe cmd