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
open! Core_kernel
open! Async_kernel
open! Import
open Incr.Let_syntax
include To_incr_dom_intf
let create_generic unpacked ~action_type_id ~input ~old_model ~model ~inject =
let%map snapshot =
Bonsai_lib.Generic.Expert.eval
~input
~old_model
~model
~inject
~action_type_id
~environment:Bonsai_types.Environment.empty
~incr_state:Incr.State.t
unpacked
and model = model in
let apply_action incoming_action _state ~schedule_action:_ =
let schedule_event = Vdom.Event.Expert.handle_non_dom_event_exn in
Bonsai_lib.Generic.Expert.Snapshot.apply_action
snapshot
~schedule_event
incoming_action
in
let view, extra = Bonsai_lib.Generic.Expert.Snapshot.result snapshot in
Incr_dom.Component.create_with_extra ~extra ~apply_action model view
;;
let convert_generic
(type input model action extra)
(unpacked :
( input
, model
, action
, Vdom.Node.t * extra
, Incr.state_witness
, Vdom.Event.t )
Bonsai_lib.Generic.Expert.unpacked)
~default_model
~(action_type_id : action Type_equal.Id.t)
~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
type t = action
let sexp_of_t = Type_equal.Id.to_sexp action_type_id
end
module Extra = struct
type t = extra
end
type t = (Action.t, Model.t, unit, Extra.t) Incr_dom.Component.with_extra
let create ~input ~old_model ~model ~inject =
create_generic unpacked ~action_type_id ~input ~old_model ~model ~inject
;;
end)
;;
let convert_with_extra component =
let (T { unpacked; action_type_id; model }) =
component |> Bonsai.to_generic |> Bonsai_lib.Generic.Expert.reveal
in
convert_generic
unpacked
~action_type_id
~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.map component ~f:(fun r -> r, ()))