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
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
open! Core
open! Async_kernel
open! Import
open Incr.Let_syntax
include To_incr_dom_intf

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

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

module Action = struct
  type ('dynamic_action, 'static_action) t =
    | Dynamic of 'dynamic_action
    | Static of 'static_action
  [@@deriving sexp_of]
end

module Action_unshadowed = Action

let create_generic
      run
      ~fresh
      ~input
      ~model
      ~inject_dynamic
      ~inject_static
      ~apply_static
      ~apply_dynamic
  =
  let environment =
    Bonsai.Private.Environment.(empty |> add_exn ~key:fresh ~data:input)
  in
  let snapshot =
    run
      ~environment
      ~path:Bonsai.Private.Path.empty
      ~clock:Incr.clock
      ~model
      ~inject_dynamic
      ~inject_static
  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:_ =
    match action with
    | Action.Dynamic action ->
      apply_dynamic
        ~inject_dynamic
        ~inject_static
        ~schedule_event
        (Some input)
        model
        action
    | Action.Static action ->
      apply_static ~inject_dynamic ~inject_static ~schedule_event 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
  in
  Incr_dom.Component.create_with_extra ~on_display ~extra ~apply_action model view
;;

let convert_generic
      (type input action_input model dynamic_action static_action extra)
      ~fresh
      ~(run :
          ( model
          , dynamic_action
          , static_action
          , action_input
          , Vdom.Node.t * extra )
            Bonsai.Private.Computation.eval_fun)
      ~default_model
      ~(dynamic_action_type_id : dynamic_action Bonsai.Private.Meta.Action.t)
      ~(static_action_type_id : static_action Bonsai.Private.Meta.Action.t)
      ~apply_static
      ~apply_dynamic
      ~equal_model
      ~sexp_of_model
      ~model_of_sexp
  : (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]

      let default = default_model
    end

    module Action = struct
      let sexp_of_dynamic_action =
        Bonsai.Private.Meta.Action.Type_id.to_sexp dynamic_action_type_id
      ;;

      let sexp_of_static_action =
        Bonsai.Private.Meta.Action.Type_id.to_sexp static_action_type_id
      ;;

      type t = (dynamic_action, static_action) Action.t [@@deriving sexp_of]
    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 =
      let inject_dynamic a = inject (Action_unshadowed.Dynamic a) in
      let inject_static a = inject (Action_unshadowed.Static a) in
      create_generic
        run
        ~fresh
        ~input
        ~model
        ~inject_dynamic
        ~inject_static
        ~apply_static
        ~apply_dynamic
    ;;
  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 = _
         ; dynamic_action
         ; static_action
         ; apply_static
         ; apply_dynamic
         ; run
         ; reset = _
         })
    =
    component var
    |> Bonsai.Private.reveal_computation
    |> maybe_optimize
    |> Bonsai.Private.gather
  in
  convert_generic
    ~run
    ~fresh
    ~dynamic_action_type_id:dynamic_action
    ~static_action_type_id:static_action
    ~apply_static
    ~apply_dynamic
    ~default_model:model.default
    ~equal_model:model.equal
    ~sexp_of_model:model.sexp_of
    ~model_of_sexp:model.of_sexp
;;

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