Source file inertness_management.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
open! Core
open Js_of_ocaml
open Virtual_dom
let set_inert (element : Dom_html.element Js.t) =
element##setAttribute (Js.string "inert") (Js.string "")
;;
let remove_inert (element : Dom_html.element Js.t) =
element##removeAttribute (Js.string "inert")
;;
module Int_key : sig
type t [@@deriving sexp, equal, compare, hash]
val create : unit -> t
end = struct
let global_val = ref 0
include Int
let create () =
incr global_val;
!global_val
;;
end
module Modal_key = struct
include Int_key
end
module Subscriber_key = struct
include Int_key
end
let open_modals = Hashtbl.create (module Modal_key)
let subscribers = Hashtbl.create (module Subscriber_key)
module Sequenced_id = struct
let global_counter = ref Int63.zero
let get_next () =
let r = !global_counter in
Int63.incr global_counter;
r
;;
end
let subscribe f =
let key = Subscriber_key.create () in
Hashtbl.add_exn subscribers ~key ~data:f;
key
;;
let unsubscribe key = Hashtbl.remove subscribers key
let on_state_change () =
let modal_opened_most_recently_at =
Hashtbl.fold open_modals ~init:None ~f:(fun ~key:_ ~data:timestamp -> function
| None -> Some timestamp
| Some acc_timestamp -> Int63.max timestamp acc_timestamp |> Some)
in
let update_app_root_inertness =
match modal_opened_most_recently_at with
| None -> remove_inert
| Some _ -> set_inert
in
Incr_dom.Start_app.Private_for_toplayer_to_mutate_inertness.connected_app_roots ()
|> List.iter ~f:update_app_root_inertness;
Hashtbl.iter subscribers ~f:(fun f -> f ~modal_opened_most_recently_at)
;;
let open_modal () =
let key = Modal_key.create () in
let opened_at = Sequenced_id.get_next () in
Hashtbl.add_exn open_modals ~key ~data:opened_at;
on_state_change ();
key, opened_at
;;
let close_modal key =
Hashtbl.remove open_modals key;
on_state_change ()
;;
let reset () =
Hashtbl.clear open_modals;
Hashtbl.clear subscribers;
on_state_change ()
;;
let inertness_subscription ~element ~opened_at ~modal_opened_most_recently_at =
match modal_opened_most_recently_at with
| None -> remove_inert element
| Some modal_opened_most_recently_at ->
if Int63.(opened_at < modal_opened_most_recently_at)
then set_inert element
else remove_inert element
;;
module For_modal = Vdom.Attr.Hooks.Make (struct
module State = struct
type t =
{ modal_key : Modal_key.t
; subscriber_key : Subscriber_key.t
}
end
module Input = struct
type t = unit [@@deriving sexp, equal]
let combine () () = ()
end
let init () element =
let modal_key, opened_at = open_modal () in
{ State.modal_key
; subscriber_key = subscribe (inertness_subscription ~element ~opened_at)
}
;;
let on_mount = `Do_nothing
let update ~old_input:_ ~new_input:_ _ _elem = ()
let destroy () { State.modal_key; subscriber_key } _ =
unsubscribe subscriber_key;
close_modal modal_key
;;
end)
module For_popover = Vdom.Attr.Hooks.Make (struct
module State = struct
type t = Subscriber_key.t
end
module Input = struct
type t = unit [@@deriving sexp, equal]
let combine () () = ()
end
let init () element =
subscribe (inertness_subscription ~element ~opened_at:(Sequenced_id.get_next ()))
;;
let on_mount = `Do_nothing
let update ~old_input:_ ~new_input:_ _ _elem = ()
let destroy () subscriber_key _ = unsubscribe subscriber_key
end)
let for_modal =
For_modal.create () |> Vdom.Attr.create_hook "vdom_toplayer_modal_inertness"
;;
let for_popover =
For_popover.create () |> Vdom.Attr.create_hook "vdom_toplayer_popover_inertness"
;;