package bonsai

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

Source file proc.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
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
open! Core
open Bonsai.For_open
open! Import

module Result_spec = struct
  module type S = sig
    type t
    type incoming

    val view : t -> string
    val incoming : t -> incoming -> unit Effect.t
  end

  type ('result, 'incoming) t =
    (module S with type t = 'result and type incoming = 'incoming)

  module No_incoming = struct
    type incoming = Nothing.t

    let incoming _t incoming = Nothing.unreachable_code incoming
  end

  module type Sexpable = sig
    type t [@@deriving sexp_of]
  end

  module type Stringable = sig
    type t

    val to_string : t -> string
  end

  let invisible (type a) : (a, Nothing.t) t =
    (module struct
      type t = a

      include No_incoming

      let view _ = ""
    end)
  ;;

  let sexp (type a) (module S : Sexpable with type t = a) =
    (module struct
      type t = a

      include No_incoming

      let view s = s |> S.sexp_of_t |> Sexp.to_string_hum
    end : S
      with type t = a
       and type incoming = Nothing.t)
  ;;

  let string (type a) (module S : Stringable with type t = a) =
    (module struct
      type t = a

      include No_incoming

      let view s = s |> S.to_string
    end : S
      with type t = a
       and type incoming = Nothing.t)
  ;;
end

module Handle = struct
  type ('result, 'incoming) t =
    (unit, 'result * string * ('incoming -> unit Effect.t)) Driver.t

  let create
        (type result incoming)
        ?(start_time = Time_ns.epoch)
        ~optimize
        (result_spec : (result, incoming) Result_spec.t)
        computation
    =
    let (module R) = result_spec in
    let component (_ : unit Value.t) =
      let open Bonsai.Let_syntax in
      let%sub result = computation in
      return
        (let%map result = result in
         result, R.view result, R.incoming result)
    in
    let clock = Incr.Clock.create ~start:start_time () in
    Driver.create ~optimize ~initial_input:() ~clock component
  ;;

  let node_paths_from_skeleton
    : type a. a Bonsai.Private.Computation.t -> Bonsai.Private.Node_path.Set.t
    =
    fun t ->
      let find_node_paths =
        object
          inherit
            [Bonsai.Private.Node_path.Set.t] Bonsai.Private.Skeleton.Traverse.fold as super

          method! value value acc =
            let acc = Set.add acc (Lazy.force value.node_path) in
            super#value value acc

          method! computation computation acc =
            let acc = Set.add acc (Lazy.force computation.node_path) in
            super#computation computation acc
        end
      in
      find_node_paths#computation
        (Bonsai.Private.Skeleton.Computation.of_computation t)
        Bonsai.Private.Node_path.Set.empty
  ;;

  let node_paths_from_transform
    : type a. a Bonsai.Private.Computation.t -> Bonsai.Private.Node_path.Set.t
    =
    fun t ->
      let node_paths = ref Bonsai.Private.Node_path.Set.empty in
      let computation_map
            (type result)
            (context : _ Bonsai.Private.Transform.For_computation.context)
            state
            (computation : result Bonsai.Private.Computation.t)
        =
        node_paths := Set.add !node_paths (Lazy.force context.current_path);
        let out = context.recurse state computation in
        out
      in
      let value_map
            (type a)
            (context : _ Bonsai.Private.Transform.For_value.context)
            state
            (wrapped_value : a Bonsai.Private.Value.t)
        =
        node_paths := Set.add !node_paths (Lazy.force context.current_path);
        context.recurse state wrapped_value
      in
      let (_ : _ Bonsai.Private.Computation.t) =
        Bonsai.Private.Transform.map
          ~init:()
          ~computation_mapper:{ f = computation_map }
          ~value_mapper:{ f = value_map }
          t
      in
      !node_paths
  ;;

  let assert_node_paths_identical_between_transform_and_skeleton_nodepaths
    : type a. a Bonsai.Private.Computation.t -> unit
    =
    fun computation ->
      let from_transform = node_paths_from_transform computation in
      let from_skeleton = node_paths_from_skeleton computation in
      if not ([%equal: Set.M(Bonsai.Private.Node_path).t] from_transform from_skeleton)
      then (
        Expect_test_helpers_core.print_cr
          [%here]
          (Sexp.Atom "BUG IN BONSAI! Node Path Mismatch");
        Expect_test_patdiff.print_patdiff_s
          ([%sexp_of: Bonsai.Private.Node_path.Set.t] from_transform)
          ([%sexp_of: Bonsai.Private.Node_path.Set.t] from_skeleton))
  ;;

  let create
        (type result incoming)
        ?start_time
        ?(optimize = true)
        (result_spec : (result, incoming) Result_spec.t)
        computation
    =
    assert_node_paths_identical_between_transform_and_skeleton_nodepaths
      (Bonsai.Private.reveal_computation computation);
    create ?start_time ~optimize result_spec computation
  ;;

  let result handle =
    Driver.flush handle;
    let result, _, _ = Driver.result handle in
    result
  ;;

  let clock = Driver.clock
  let advance_clock_by t = Incr.Clock.advance_clock_by (Driver.clock t)
  let advance_clock ~to_ t = Incr.Clock.advance_clock ~to_ (Driver.clock t)

  let do_actions handle actions =
    let _, _, inject_action = Driver.result handle in
    let event = actions |> List.map ~f:inject_action |> Effect.sequence in
    Driver.schedule_event handle event
  ;;

  let recompute_view (handle : (_, 'r) Driver.t) =
    Driver.flush handle;
    let (_ : 'r) = Driver.result handle in
    Driver.trigger_lifecycles handle
  ;;

  let recompute_view_until_stable ?(max_computes = 100) handle =
    with_return (fun { return } ->
      for _ = 1 to max_computes do
        recompute_view handle;
        if not (Driver.has_after_display_events handle) then return ()
      done;
      failwithf "view not stable after %d recomputations" max_computes ())
  ;;

  let generic_show handle ~before ~f =
    let before = before handle in
    Driver.flush handle;
    let _, view, _ = Driver.result handle in
    Driver.store_view handle view;
    f before view;
    Driver.trigger_lifecycles handle
  ;;

  let show handle =
    generic_show handle ~before:(Fn.const ()) ~f:(fun () view -> print_endline view)
  ;;

  let show_diff
        ?(location_style = Patdiff_kernel.Format.Location_style.None)
        ?(diff_context = 16)
        handle
    =
    generic_show
      handle
      ~before:Driver.last_view
      ~f:(Expect_test_patdiff.print_patdiff ~location_style ~context:diff_context)
  ;;

  let store_view handle = generic_show handle ~before:(Fn.const ()) ~f:(fun () _ -> ())

  let show_model handle =
    Driver.flush handle;
    Driver.sexp_of_model handle |> print_s
  ;;

  let flush handle = Driver.flush handle

  let result_incr handle =
    let%pattern_bind.Incr result, _view, _inject = Driver.result_incr handle in
    result
  ;;

  let action_input_incr = Driver.action_input_incr
  let lifecycle_incr = Driver.lifecycle_incr
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