Source file `to_incr_dom.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
open! Core
open! Async_kernel
open! Import
open Incr.Let_syntax
include To_incr_dom_intf
module Bonsai_action = Bonsai.Private.Action

module State = struct
  type t = { mutable last_lifecycle : Bonsai.Private.Lifecycle.Collection.t }

  let create () = { last_lifecycle = Bonsai.Private.Lifecycle.Collection.empty }
end

let create_generic run ~fresh ~input ~model ~inject ~apply_action =
  let environment =
    Bonsai.Private.Environment.(empty |> add_exn ~key:fresh ~data:input)
  in
  let snapshot, () =
    run
      ~environment
      ~path:Bonsai.Private.Path.empty
      ~clock:Incr_dom.Start_app.Private.time_source
      ~model
      ~inject
    |> Bonsai.Private.Trampoline.run
  in
  let%map view, extra = Bonsai.Private.Snapshot.result snapshot
  and input = Bonsai.Private.Input.to_incremental (Bonsai.Private.Snapshot.input snapshot)
  and lifecycle = Bonsai.Private.Snapshot.lifecycle_or_empty snapshot
  and model = model in
  let schedule_event = Vdom.Effect.Expert.handle_non_dom_event_exn in
  let apply_action action _state ~schedule_action:_ =
    apply_action ~inject ~schedule_event (Some input) model action
  in
  let on_display state ~schedule_action:_ =
    let diff =
      Bonsai.Private.Lifecycle.Collection.diff state.State.last_lifecycle lifecycle
    in
    state.State.last_lifecycle <- lifecycle;
    Vdom.Effect.Expert.handle_non_dom_event_exn diff;
    Bonsai.Time_source.Private.trigger_after_display
      Incr_dom.Start_app.Private.time_source
  in
  Incr_dom.Component.create_with_extra ~on_display ~extra ~apply_action model view
;;

let convert_generic
  (type input action_input model action extra)
  ~fresh
  ~(run :
      ( model
      , action
      , action_input
      , Vdom.Node.t * extra
      , unit )
      Bonsai.Private.Computation.eval_fun)
  ~default_model
  ~(action_type_id : action Bonsai_action.id)
  ~apply_action
  ~equal_model
  ~sexp_of_model
  : (module S with type Input.t = input and type Extra.t = extra)
  =
  (module struct
    module Input = struct
      type t = input
    end

    module Model = struct
      type t = model [@@deriving equal, sexp_of]

      let default = default_model
    end

    module Action = struct
      type t = action Bonsai_action.t

      let sexp_of_t = Bonsai_action.Type_id.to_sexp action_type_id
    end

    module Extra = struct
      type t = extra
    end

    module State = State

    type t = (Action.t, Model.t, State.t, Extra.t) Incr_dom.Component.with_extra

    let create ~input ~old_model:_ ~model ~inject =
      create_generic run ~fresh ~input ~model ~inject ~apply_action
    ;;
  end)
;;

let convert_with_extra ?(optimize = false) component =
  let fresh = Type_equal.Id.create ~name:"" sexp_of_opaque in
  let var = Bonsai.Private.(Value.named App_input fresh |> conceal_value) in
  let maybe_optimize = if optimize then Bonsai.Private.pre_process else Fn.id in
  let (T
        { model
        ; input = _
        ; action
        ; apply_action
        ; run
        ; reset = _
        ; may_contain_path = _
        ; may_contain_lifecycle = _
        })
    =
    component var
    |> Bonsai.Private.top_level_handle
    |> maybe_optimize
    |> Bonsai.Private.gather
  in
  convert_generic
    ~run
    ~fresh
    ~action_type_id:action
    ~apply_action
    ~default_model:model.default
    ~equal_model:model.equal
    ~sexp_of_model:model.sexp_of
;;

let convert ?optimize component =
  convert_with_extra ?optimize (Bonsai.Arrow_deprecated.map component ~f:(fun r -> r, ()))
;;