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
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
      computation
      ~fresh
      ~input
      ~model
      ~inject_dynamic
      ~inject_static
      ~apply_static
  =
  let environment =
    Bonsai.Private.Environment.(empty |> add_exn ~key:fresh ~data:input)
  in
  let snapshot =
    Bonsai.Private.eval
      ~environment
      ~path:Bonsai.Private.Path.empty
      ~clock:Incr.clock
      ~model
      ~inject_dynamic
      ~inject_static
      computation
  in
  let%map view, extra = Bonsai.Private.Snapshot.result snapshot
  and dynamic_apply_action =
    Bonsai.Private.Apply_action.to_incremental
      (Bonsai.Private.Snapshot.apply_action 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 -> dynamic_apply_action model action ~schedule_event
    | Action.Static action ->
      apply_static ~inject: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 model dynamic_action static_action extra)
      ~fresh
      ~(computation :
          ( model
          , dynamic_action
          , static_action
          , Vdom.Node.t * extra )
            Bonsai.Private.Computation.t)
      ~default_model
      ~(dynamic_action_type_id : dynamic_action Type_equal.Id.t)
      ~(static_action_type_id : static_action Type_equal.Id.t)
      ~apply_static
      ~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 = Type_equal.Id.to_sexp dynamic_action_type_id
      let sexp_of_static_action = Type_equal.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
        computation
        ~fresh
        ~input
        ~model
        ~inject_dynamic
        ~inject_static
        ~apply_static
    ;;
  end)
;;

let convert_with_extra component =
  let fresh = Type_equal.Id.create ~name:"" sexp_of_opaque in
  let var = Bonsai.Private.(Value.named fresh |> conceal_value) in
  let component = component var |> Bonsai.Private.reveal_computation in
  let (Bonsai.Private.Computation.T
         { t; model; dynamic_action; static_action; apply_static })
    =
    component
  in
  convert_generic
    ~computation:t
    ~fresh
    ~dynamic_action_type_id:dynamic_action
    ~static_action_type_id:static_action
    ~apply_static
    ~default_model:model.default
    ~equal_model:model.equal
    ~sexp_of_model:model.sexp_of
    ~model_of_sexp:model.of_sexp
;;

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