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
open! Core
open! Async_kernel
open! Import
type ('model, 'action, 'state) t =
{ model_var : 'model Incr.Var.t
; old_model_var : 'model Incr.Var.t
; state : 'state
; view_incr : Vdom.Node.t Incr.t
; app_obs : ('action, 'model, 'state) Incr_dom.Component.t Incr.Observer.t
; action_queue : 'action Queue.t
; set_time : Time_ns.t -> unit
; sexp_of_model : 'model -> Sexp.t
}
[@@deriving fields]
let create
(type model action state)
~(initial_model : model)
~sexp_of_model
~initial_state:state
(module App : Incr_dom.App_intf.S
with type Model.t = model
and type Action.t = action
and type State.t = state)
=
let action_queue = Queue.create () in
let module Event =
Vdom.Effect.Define (struct
module Action = App.Action
let handle = Queue.enqueue action_queue
end)
in
let inject = Event.inject in
let model_var = Incr.Var.create initial_model in
let model_incr = Incr.Var.watch model_var in
let old_model_var = Incr.Var.create initial_model in
let old_model_incr = Incr.Var.watch old_model_var in
Incr.set_cutoff
model_incr
(Incr.Cutoff.create (fun ~old_value ~new_value ->
App.Model.cutoff old_value new_value));
let app_incr = App.create model_incr ~old_model:old_model_incr ~inject in
let app_obs = Incr.observe app_incr in
let set_time to_ = Incr.Clock.advance_clock Incr.clock ~to_ in
let view_incr = Incr.map app_incr ~f:Incr_dom.Component.view in
{ model_var
; old_model_var
; state
; view_incr
; app_obs
; action_queue
; set_time
; sexp_of_model
}
;;
let perform_update t =
let schedule_action = Queue.enqueue t.action_queue in
let apply_action action =
let apply_action =
t.app_obs |> Incr.Observer.value_exn |> Incr_dom.Component.apply_action
in
let new_model = apply_action action t.state ~schedule_action in
Incr.Var.set t.model_var new_model;
Incr.stabilize ()
in
Incr.stabilize ();
while not (Queue.is_empty t.action_queue) do
apply_action (Queue.dequeue_exn t.action_queue)
done;
Incr.Var.set t.old_model_var (Incr.Var.value t.model_var)
;;