package bonsai

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

Source file test_effect_throttling.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
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
open! Core
open! Import
open Proc
open Bonsai.For_open

let create_handle component =
  Handle.create
    (module struct
      type t = int -> int Bonsai.Effect_throttling.Poll_result.t Effect.t
      type incoming = int

      let view _ = ""

      let incoming f query =
        let%bind.Effect result = f query in
        Effect.print_s
          [%message (query : int) (result : int Bonsai.Effect_throttling.Poll_result.t)]
      ;;
    end)
    component
;;

module Common (M : sig
    val poll
      :  ('a -> 'b Effect.t) Value.t
      -> ('a -> 'b Bonsai.Effect_throttling.Poll_result.t Effect.t) Computation.t
  end) =
struct
  let%expect_test {| Effect_throttling.poll only runs one instance of an effect at a time |}
    =
    let qrt = Effect.For_testing.Query_response_tracker.create () in
    let respond q =
      Effect.For_testing.Query_response_tracker.maybe_respond qrt ~f:(fun _ -> Respond q)
    in
    let component =
      M.poll (Value.return (Effect.For_testing.of_query_response_tracker qrt))
    in
    let handle = create_handle component in
    Handle.do_actions handle [ 0; 1; 2 ];
    Handle.recompute_view handle;
    (* query 1 gets aborted because only 1 request can be enqueued at a time *)
    [%expect {| ((query 1) (result Aborted)) |}];
    respond 1;
    [%expect {| ((query 0) (result (Finished 1))) |}];
    respond 2;
    (* We call [recompute_view] after [respond 2] and before [respond 3] to
       demonstrate that the effect being responded to doesn't begin until the
       next time the state machine effects get run. This isn't necessarily
       desirable behavior, but it is the way this computation works, so it's
       worth showing in this test. *)
    Handle.recompute_view handle;
    [%expect {| |}];
    respond 3;
    [%expect {| ((query 2) (result (Finished 3))) |}]
  ;;

  let%expect_test {| Effect_throttling.poll resetting |} =
    let qrt = Effect.For_testing.Query_response_tracker.create () in
    let respond q =
      Effect.For_testing.Query_response_tracker.maybe_respond qrt ~f:(fun _ -> Respond q)
    in
    let effect_var =
      Bonsai.Var.create (Effect.For_testing.of_query_response_tracker qrt)
    in
    let component = Bonsai.with_model_resetter (M.poll (Bonsai.Var.value effect_var)) in
    let handle =
      Handle.create
        (module struct
          type t =
            (int -> int Bonsai.Effect_throttling.Poll_result.t Effect.t) * unit Effect.t

          type incoming =
            [ `Run of int
            | `Reset
            ]

          let view _ = ""

          let incoming (f, reset) query =
            match query with
            | `Run query ->
              let%bind.Effect result = f query in
              Effect.print_s
                [%message
                  (query : int) (result : int Bonsai.Effect_throttling.Poll_result.t)]
            | `Reset -> reset
          ;;
        end)
        component
    in
    Handle.do_actions handle [ `Run 0; `Run 1; `Run 2 ];
    Handle.recompute_view handle;
    [%expect {| ((query 1) (result Aborted)) |}];
    Handle.do_actions handle [ `Reset ];
    Handle.recompute_view handle;
    respond 1;
    Handle.recompute_view handle;
    [%expect {| ((query 0) (result (Finished 1))) |}];
    Handle.do_actions handle [ `Reset ];
    respond 2;
    [%expect {| ((query 2) (result (Finished 2))) |}]
  ;;
end

module _ = Common (struct
    let poll = Bonsai.Effect_throttling.poll
  end)

module _ = Common (struct
    let poll effect =
      let open Bonsai.Let_syntax in
      let%sub effect = Bonsai.Effect_throttling.poll effect in
      let%sub effect = Bonsai.Effect_throttling.poll effect in
      let%arr effect = effect in
      fun int ->
        match%map.Effect effect int with
        | Aborted -> Bonsai.Effect_throttling.Poll_result.Aborted
        | Finished (Finished result) -> Finished result
        | Finished Aborted -> raise_s [%message "Unexpected finished of aborted"]
    ;;
  end)


let%expect_test {| Effect_throttling.poll deactivation |} =
  let qrt = Effect.For_testing.Query_response_tracker.create () in
  let respond q =
    Effect.For_testing.Query_response_tracker.maybe_respond qrt ~f:(fun _ -> Respond q)
  in
  let effect_var = Bonsai.Var.create (Effect.For_testing.of_query_response_tracker qrt) in
  let match_var = Bonsai.Var.create true in
  let poll_effect = Bonsai.Effect_throttling.poll (Bonsai.Var.value effect_var) in
  let component =
    let open Bonsai.Let_syntax in
    if%sub Bonsai.Var.value match_var then poll_effect else poll_effect
  in
  let handle = create_handle component in
  (* The actions [ 0; 1; 2 ] are associated with the [true] branch, but don't get run
     until we flush/recompute_view. *)
  Handle.do_actions handle [ 0; 1; 2 ];
  Bonsai.Var.set match_var false;
  Handle.recompute_view handle;
  (* Since the [true] branch is inactive, no action is running, and they all count as
     "up_next". We will drop 0 and 1 because they will be replaced by 1 and 2,
     respectively, since we only allow one effect to be in the pending queue at a time *)
  [%expect {|
    ((query 0) (result Aborted))
    ((query 1) (result Aborted)) |}];
  (* The actions [ 3; 4; 5 ] are associated with the [false] branch*)
  Handle.do_actions handle [ 3; 4; 5 ];
  Handle.recompute_view handle;
  [%expect {| ((query 4) (result Aborted)) |}];
  respond 1;
  [%expect {| ((query 3) (result (Finished 1))) |}];
  (* The outstanding request doesn't get run until we flush/recompute_view so nothing is
     waiting for a response *)
  respond 2;
  [%expect {| |}];
  Handle.recompute_view handle;
  respond 3;
  [%expect {| ((query 5) (result (Finished 3))) |}];
  Handle.recompute_view handle;
  Bonsai.Var.set match_var true;
  Handle.recompute_view handle;
  Handle.recompute_view handle;
  respond 4;
  Handle.recompute_view handle;
  [%expect {| ((query 2) (result (Finished 4))) |}]
;;

let%expect_test {| Effect_throttling.poll gets activated and de-activated the next frame |}
  =
  let qrt = Effect.For_testing.Query_response_tracker.create () in
  let respond q =
    Effect.For_testing.Query_response_tracker.maybe_respond qrt ~f:(fun _ -> Respond q)
  in
  let effect_var = Bonsai.Var.create (Effect.For_testing.of_query_response_tracker qrt) in
  let match_var = Bonsai.Var.create true in
  let poll_effect = Bonsai.Effect_throttling.poll (Bonsai.Var.value effect_var) in
  let component =
    let open Bonsai.Let_syntax in
    if%sub Bonsai.Var.value match_var then poll_effect else poll_effect
  in
  let handle = create_handle component in
  Handle.do_actions handle [ 0 ];
  Bonsai.Var.set match_var false;
  Handle.recompute_view handle;
  [%expect {| |}];
  respond 1;
  Bonsai.Var.set match_var true;
  Handle.recompute_view handle;
  [%expect {| |}];
  respond 2;
  Bonsai.Var.set match_var false;
  Handle.recompute_view handle;
  [%expect {| |}];
  respond 3;
  Bonsai.Var.set match_var true;
  Handle.recompute_view handle;
  [%expect {| |}];
  respond 4;
  Handle.recompute_view handle;
  respond 5;
  [%expect {| ((query 0) (result (Finished 5))) |}]
;;

let%expect_test {| Effect_throttling.poll effect finishes while inactive and effect is queued |}
  =
  let qrt = Effect.For_testing.Query_response_tracker.create () in
  let respond q =
    Effect.For_testing.Query_response_tracker.maybe_respond qrt ~f:(fun _ -> Respond q)
  in
  let effect_var = Bonsai.Var.create (Effect.For_testing.of_query_response_tracker qrt) in
  let match_var = Bonsai.Var.create true in
  let poll_effect = Bonsai.Effect_throttling.poll (Bonsai.Var.value effect_var) in
  let component =
    let open Bonsai.Let_syntax in
    if%sub Bonsai.Var.value match_var then poll_effect else poll_effect
  in
  let handle = create_handle component in
  Handle.do_actions handle [ 0; 1 ];
  Handle.recompute_view handle;
  Handle.recompute_view handle;
  Handle.recompute_view handle;
  Bonsai.Var.set match_var false;
  [%expect {| |}];
  respond 1;
  Handle.recompute_view handle;
  [%expect {| ((query 0) (result (Finished 1))) |}];
  Bonsai.Var.set match_var true;
  Handle.recompute_view handle;
  [%expect {| |}];
  Handle.recompute_view handle;
  respond 2;
  [%expect {| ((query 1) (result (Finished 2))) |}]
;;

let%expect_test {| Effect_throttling.poll in an assoc |} =
  let qrt = Effect.For_testing.Query_response_tracker.create () in
  let respond q =
    Effect.For_testing.Query_response_tracker.maybe_respond qrt ~f:(fun _ -> Respond q)
  in
  let map_var = Bonsai.Var.create (Int.Map.of_alist_exn [ 1, (); 2, (); 3, () ]) in
  let effect_var = Bonsai.Var.create (Effect.For_testing.of_query_response_tracker qrt) in
  let component =
    let open Bonsai.Let_syntax in
    Bonsai.assoc
      (module Int)
      (Bonsai.Var.value map_var)
      ~f:(fun key _data ->
        let%sub poll_effect =
          Bonsai.Effect_throttling.poll (Bonsai.Var.value effect_var)
        in
        let%arr key = key
        and poll_effect = poll_effect in
        poll_effect key)
  in
  let handle =
    Handle.create
      (module struct
        type t = int Bonsai.Effect_throttling.Poll_result.t Effect.t Int.Map.t
        type incoming = int

        let view _ = ""

        let incoming map query =
          match Map.find map query with
          | Some effect ->
            let%bind.Effect result = effect in
            Effect.print_s
              [%message
                (query : int) (result : int Bonsai.Effect_throttling.Poll_result.t)]
          | None -> Effect.print_s [%message "Key not in map" (query : int)]
        ;;
      end)
      component
  in
  Handle.do_actions handle [ 1; 2; 3; 1; 2; 3; 2; 1; 3 ];
  Handle.recompute_view handle;
  [%expect
    {|
    ((query 2) (result Aborted))
    ((query 1) (result Aborted))
    ((query 3) (result Aborted)) |}];
  Handle.recompute_view handle;
  respond 1;
  [%expect
    {|
    ((query 3) (result (Finished 1)))
    ((query 2) (result (Finished 1)))
    ((query 1) (result (Finished 1))) |}];
  respond 2;
  Handle.recompute_view handle;
  respond 3;
  [%expect
    {|
    ((query 1) (result (Finished 3)))
    ((query 2) (result (Finished 3)))
    ((query 3) (result (Finished 3))) |}];
  Handle.do_actions handle [ 1; 2; 3; 1; 2; 3 ];
  Bonsai.Var.update map_var ~f:(fun map -> Map.remove map 1);
  Handle.recompute_view handle;
  [%expect {| ((query 1) (result Aborted)) |}];
  respond 4;
  [%expect
    {|
    ((query 3) (result (Finished 4)))
    ((query 2) (result (Finished 4))) |}]
;;

let%expect_test "collapse functions" =
  let print ?tag_s input =
    let output = Bonsai.Effect_throttling.Poll_result.collapse_to_or_error ?tag_s input in
    print_s
      [%message
        ""
          ~_:(input : unit Or_error.t Bonsai.Effect_throttling.Poll_result.t)
          "=>"
          ~_:(output : unit Or_error.t)]
  in
  print Aborted;
  print (Finished (Error (Error.of_string "oh no!")));
  print (Finished (Ok ()));
  [%expect
    {|
    (Aborted => (Error "request was aborted"))
    ((Finished (Error "oh no!")) => (Error "oh no!"))
    ((Finished (Ok ())) => (Ok ())) |}];
  print ~tag_s:(lazy (Sexp.Atom "my tag")) Aborted;
  print ~tag_s:(lazy (Sexp.Atom "my tag")) (Finished (Error (Error.of_string "oh no!")));
  [%expect
    {|
    (Aborted => (Error ("my tag" "request was aborted")))
    ((Finished (Error "oh no!")) => (Error ("my tag" "oh no!"))) |}]
;;
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