package bonsai

  1. Overview
  2. Docs
package bonsai
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file bonsai_driver.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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
open! Core
module Incr = Ui_incr

module Action = struct
  type ('dynamic_action, 'static_action) t =
    | Dynamic of 'dynamic_action
    | Static of 'static_action
end

type ('m, 'dynamic_action, 'static_action, 'action_input, 'r) unpacked =
  { model_var : 'm Incr.Var.t
  ; default_model : 'm
  ; clock : Incr.Clock.t
  ; inject : ('dynamic_action, 'static_action) Action.t -> unit Ui_effect.t
  ; sexp_of_model : 'm -> Sexp.t
  ; action_input_incr : 'action_input Incr.t
  ; action_input : 'action_input Incr.Observer.t
  ; static_apply_action :
      schedule_event:(unit Ui_effect.t -> unit) -> 'm -> 'static_action -> 'm
  ; dynamic_apply_action :
      schedule_event:(unit Ui_effect.t -> unit)
      -> 'action_input option
      -> 'm
      -> 'dynamic_action
      -> 'm
  ; result : 'r Incr.Observer.t
  ; result_incr : 'r Incr.t
  ; lifecycle : Bonsai.Private.Lifecycle.Collection.t Incr.Observer.t
  ; lifecycle_incr : Bonsai.Private.Lifecycle.Collection.t Incr.t
  ; queue : ('dynamic_action, 'static_action) Action.t Queue.t
  ; mutable last_lifecycle : Bonsai.Private.Lifecycle.Collection.t
  }

type 'r t = T : (_, _, _, _, 'r) unpacked -> 'r t

let assert_type_equalities
      (T a : _ Bonsai.Private.Computation.packed_info)
      (T b : _ Bonsai.Private.Computation.packed_info)
  =
  let T =
    Bonsai.Private.Meta.Model.Type_id.same_witness_exn a.model.type_id b.model.type_id
  in
  let T =
    Bonsai.Private.Meta.Action.Type_id.same_witness_exn a.dynamic_action b.dynamic_action
  in
  let T =
    Bonsai.Private.Meta.Action.Type_id.same_witness_exn a.static_action b.static_action
  in
  ()
;;

let create
      (type r)
      ?initial_model_sexp
      ?(optimize = true)
      ~clock
      (computation : r Bonsai.Computation.t)
  : r t
  =
  let unoptimized_info =
    Bonsai.Private.gather (Bonsai.Private.reveal_computation computation)
  in
  let optimized_info =
    Bonsai.Private.reveal_computation computation
    |> (if optimize then Bonsai.Private.pre_process else Fn.id)
    |> Bonsai.Private.gather
  in
  let (T
         ({ model =
              { default = default_model
              ; sexp_of = sexp_of_model
              ; equal = _
              ; type_id = _
              ; of_sexp = model_of_sexp
              }
          ; input = _
          ; apply_static
          ; apply_dynamic
          ; dynamic_action = _
          ; static_action = _
          ; run = _
          ; reset = _
          } as computation_info))
    =
    optimized_info
  in
  assert_type_equalities unoptimized_info unoptimized_info;
  assert_type_equalities optimized_info optimized_info;
  let environment = Bonsai.Private.Environment.empty in
  let starting_model =
    Option.value_map initial_model_sexp ~default:default_model ~f:[%of_sexp: model]
  in
  let model_var = Incr.Var.create starting_model in
  (* Sadly the only way to give a name to the existential type that we just introduced
     into the environment is by defining a function like this. See
     https://github.com/ocaml/ocaml/issues/7074. *)
  let create_polymorphic
        (type dynamic_action static_action action_input)
        (computation_info :
           (_, dynamic_action, static_action, action_input, r) Bonsai.Private.Computation.info)
        apply_static
        apply_dynamic
    : r t
    =
    let queue = Queue.create () in
    let module A =
      Ui_effect.Define (struct
        module Action = struct
          type t = (dynamic_action, static_action) Action.t
        end

        let handle = Queue.enqueue queue
      end)
    in
    let inject = A.inject in
    let inject_dynamic a = A.inject (Dynamic a) in
    let inject_static a = A.inject (Static a) in
    let snapshot =
      computation_info.run
        ~environment
        ~path:Bonsai.Private.Path.empty
        ~clock
        ~model:(Incr.Var.watch model_var)
        ~inject_dynamic
        ~inject_static
    in
    let result_incr = Bonsai.Private.Snapshot.result snapshot in
    let action_input_incr =
      Bonsai.Private.Input.to_incremental (Bonsai.Private.Snapshot.input snapshot)
    in
    let action_input = Incr.observe action_input_incr in
    let result = result_incr |> Incr.observe in
    let lifecycle_incr = Bonsai.Private.Snapshot.lifecycle_or_empty snapshot in
    let lifecycle = Incr.observe lifecycle_incr in
    Incr.stabilize ();
    T
      { model_var
      ; default_model
      ; clock
      ; inject
      ; action_input
      ; action_input_incr
      ; static_apply_action = apply_static ~inject_dynamic ~inject_static
      ; dynamic_apply_action = apply_dynamic ~inject_dynamic ~inject_static
      ; result
      ; result_incr
      ; sexp_of_model
      ; lifecycle
      ; lifecycle_incr
      ; queue
      ; last_lifecycle = Bonsai.Private.Lifecycle.Collection.empty
      }
  in
  create_polymorphic computation_info apply_static apply_dynamic
;;

let schedule_event _ = Ui_effect.Expert.handle

let flush
      (T { model_var; static_apply_action; dynamic_apply_action; action_input; queue; _ })
  =
  let update_model ~action ~apply_action =
    (* The only difference between [Var.latest_value] and [Var.value] is that
       if [Var.set] is called _while stabilizing_, then calling [Var.value]
       will return the value that was set when stabilization started, whereas
       [latest_value] will give you the value that was just [set].  Now,
       setting a model in the middle of a stabilizaiton should never happen,
       but I think it's important to be explicit about which behavior we use,
       so I chose the one that would be least surprising if a stabilization
       does happen to occur. *)
    Incr.Var.set
      model_var
      (apply_action
         ~schedule_event:Ui_effect.Expert.handle
         (Incr.Var.latest_value model_var)
         action)
  in
  let process_event (action : _ Action.t) =
    match action with
    | Static action -> update_model ~apply_action:static_apply_action ~action
    | Dynamic action ->
      (* We need to stabilize before every action so that the [input] for the
         apply-actions are up to date. *)
      Incr.stabilize ();
      let action_input = Incr.Observer.value_exn action_input in
      let apply_action ~schedule_event model action =
        dynamic_apply_action ~schedule_event (Some action_input) model action
      in
      update_model ~action ~apply_action
  in
  while not (Queue.is_empty queue) do
    process_event (Queue.dequeue_exn queue)
  done;
  Incr.stabilize ()
;;

let result (T { result; _ }) = Incr.Observer.value_exn result

let has_after_display_events (T t) =
  let lifecycle = t.lifecycle |> Incr.Observer.value_exn in
  Bonsai.Private.Lifecycle.Collection.has_after_display lifecycle
;;

let trigger_lifecycles (T t) =
  let old = t.last_lifecycle in
  let new_ = t.lifecycle |> Incr.Observer.value_exn in
  t.last_lifecycle <- new_;
  schedule_event () (Bonsai.Private.Lifecycle.Collection.diff old new_)
;;

module Expert = struct
  let sexp_of_model (T { sexp_of_model; model_var; _ }) =
    sexp_of_model (Incr.Var.value model_var)
  ;;

  let result_incr (T { result_incr; _ }) = result_incr
  let action_input_incr (T { action_input_incr; _ }) = Ui_incr.pack action_input_incr
  let lifecycle_incr (T { lifecycle_incr; _ }) = Ui_incr.pack lifecycle_incr
  let clock (T { clock; _ }) = clock

  let invalidate_observers (T { action_input; result; lifecycle; _ }) =
    Incr.Observer.disallow_future_use action_input;
    Incr.Observer.disallow_future_use result;
    Incr.Observer.disallow_future_use lifecycle
  ;;

  let reset_model_to_default (T { default_model; model_var; _ }) =
    Incr.Var.set model_var default_model
  ;;
end
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct