Skip to content

Commit bafaeb8

Browse files
jiquiamejiquiame
committed
fix(log tab): remove infinite loop of log queries
1 parent ecd046d commit bafaeb8

File tree

14 files changed

+109
-93
lines changed

14 files changed

+109
-93
lines changed

‎core/api/kappa_facade.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -159,7 +159,7 @@ let parse ~patternSharing (parsing_compil : Ast.parsing_compil) var_overwrite
159159
>>= fun (ast_compiled_data : LKappa_compiler.ast_compiled_data) ->
160160
yield () >>= fun () ->
161161
(* The last yield is updated after the last yield.
162-
It is gotten here for the initial last yeild value. *)
162+
It is gotten here for the initial last yield value. *)
163163
let lastyield = Sys.time () in
164164
try
165165
(* exception raised by compile must have used Lwt.fail.

‎core/api/kasim_client.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -253,7 +253,7 @@ class virtual new_client ~post () : manager_simulation_mpi =
253253
in
254254
result
255255
) else
256-
Lwt.return (Api_common.err_result_of_string "Kappa has died")
256+
Lwt.return (Api_common.err_result_of_string "Kasim has died")
257257

258258
method private sim_is_computing = not (IntMap.is_empty context.mailboxes)
259259
end

‎gui/lib/ui_common.ml‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -236,6 +236,21 @@ let id_dom (id : string) : 'a Js.t =
236236
(Format.sprintf "ui_common.id_dom : could not find id %s" id))
237237
: Dom_html.element Js.t)
238238

239+
let switch_class elt_id add_list remove_list =
240+
let dom_elt : 'a Js.t = id_dom elt_id |> Js.Unsafe.coerce in
241+
List.iter
242+
(fun (class_str : string) ->
243+
Js.Unsafe.meth_call dom_elt##.classList "add"
244+
[| Js.string class_str |> Js.Unsafe.coerce |])
245+
add_list;
246+
List.iter
247+
(fun (class_str : string) ->
248+
Js.Unsafe.meth_call dom_elt##.classList "remove"
249+
[| Js.string class_str |> Js.Unsafe.coerce |])
250+
remove_list
251+
252+
(* modals *)
253+
239254
let create_modal_text_input ~(id : string) ~(title_label : string)
240255
~(body : [< Html_types.div_content_fun ] Html.elt Html.list_wrap)
241256
~(submit_label : string) ~(submit : ('self Js.t, _ Js.t) Dom.event_listener)

‎gui/lib/ui_common.mli‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,8 +56,12 @@ module type Panel = sig
5656
val onresize : unit -> unit
5757
end
5858

59-
val id_dom : string -> 'a Js.t
6059
val document : Dom_html.document Js.t
60+
val id_dom : string -> 'a Js.t
61+
62+
val switch_class : string -> string list -> string list -> unit
63+
(** [switch_class elt_id add_list remove_list] adds and removes classes
64+
to DOM element with id `elt_id` *)
6165

6266
val navtabs :
6367
string ->

‎gui/lib_no_jsoo/hooked.ml‎

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module type S = sig
1515
'a t * (?debug:string -> 'a -> unit)
1616

1717
val register : 'a t -> ('a -> unit) -> unit
18+
val register_lwt : 'a t -> ('a -> unit Lwt.t) -> unit
1819
val value : 'a t -> 'a
1920
val set : ?debug:string -> 'a t -> 'a -> unit
2021

@@ -57,6 +58,7 @@ module MakeS (D : DebugPrint) : S = struct
5758
type 'a t = {
5859
mutable value: 'a;
5960
mutable hooks: ('a -> unit) list;
61+
mutable hooks_lwt: ('a -> unit Lwt.t) list;
6062
eq: 'a -> 'a -> bool;
6163
signal: 'a React.signal;
6264
set_signal: ?step:React.step -> 'a -> unit;
@@ -79,6 +81,7 @@ module MakeS (D : DebugPrint) : S = struct
7981
{
8082
value = a;
8183
hooks = [];
84+
hooks_lwt = [];
8285
eq;
8386
signal;
8487
set_signal;
@@ -93,10 +96,18 @@ module MakeS (D : DebugPrint) : S = struct
9396
_log hooked "register";
9497
hooked.hooks <- f :: hooked.hooks
9598

99+
let register_lwt hooked f =
100+
_log hooked "register";
101+
hooked.hooks_lwt <- f :: hooked.hooks_lwt
102+
96103
let value hooked =
97104
_log hooked "value";
98105
hooked.value
99106

107+
let call_hooks hooked =
108+
List.iter (fun f -> f hooked.value) hooked.hooks;
109+
List.iter (fun f -> f hooked.value |> ignore) hooked.hooks_lwt
110+
100111
let set ?(debug = "") hooked value =
101112
let value_changed = hooked.eq value hooked.value in
102113
if not value_changed then (
@@ -108,7 +119,7 @@ module MakeS (D : DebugPrint) : S = struct
108119
"")
109120
(List.length hooked.hooks));
110121
hooked.value <- value;
111-
List.iter (fun f -> f value) hooked.hooks;
122+
call_hooks hooked;
112123
hooked.set_signal value
113124
) else
114125
_log hooked "set NO change"

‎gui/lib_no_jsoo/hooked.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ module type S = sig
1414
'a t * (?debug:string -> 'a -> unit)
1515

1616
val register : 'a t -> ('a -> unit) -> unit
17+
val register_lwt : 'a t -> ('a -> unit Lwt.t) -> unit
1718
val value : 'a t -> 'a
1819
val set : ?debug:string -> 'a t -> 'a -> unit
1920

‎gui/state/state_simulation.ml‎

Lines changed: 11 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88

99
open Lwt.Infix
1010

11+
(* private simulation state *)
1112
type simulation_state =
1213
| SIMULATION_STATE_STOPPED (* simulation is unavailable *)
1314
| SIMULATION_STATE_INITALIZING (* simulation is blocked on an operation *)
@@ -16,31 +17,25 @@ type simulation_state =
1617

1718
type t = { simulation_state: simulation_state }
1819

19-
let t_simulation_state simulation = simulation.simulation_state
20-
21-
let t_simulation_info simulation : Api_types_j.simulation_info option =
20+
let get_simulation_info simulation : Api_types_j.simulation_info option =
2221
match simulation.simulation_state with
2322
| SIMULATION_STATE_STOPPED -> None
2423
| SIMULATION_STATE_INITALIZING -> None
2524
| SIMULATION_STATE_READY simulation_info -> Some simulation_info
2625

27-
type state = t
28-
type model = state
29-
type model_state = STOPPED | INITALIZING | RUNNING | PAUSED
26+
(* public simulation status *)
27+
type simulation_status = STOPPED | INITALIZING | RUNNING | PAUSED
3028

31-
let model_state_to_string = function
29+
let simulation_status_to_string = function
3230
| STOPPED -> "Stopped"
3331
| INITALIZING -> "Initalizing"
3432
| RUNNING -> "Running"
3533
| PAUSED -> "Paused"
3634

3735
let dummy_model = { simulation_state = SIMULATION_STATE_STOPPED }
3836

39-
let model_simulation_info model : Api_types_j.simulation_info option =
40-
t_simulation_info model
41-
42-
let model_simulation_state model : model_state =
43-
match t_simulation_state model with
37+
let model_simulation_state model : simulation_status =
38+
match model.simulation_state with
4439
| SIMULATION_STATE_STOPPED -> STOPPED
4540
| SIMULATION_STATE_INITALIZING -> INITALIZING
4641
| SIMULATION_STATE_READY simulation_info ->
@@ -52,14 +47,16 @@ let model_simulation_state model : model_state =
5247
else
5348
PAUSED
5449

50+
(* private state *)
5551
let state, set_state = React.S.create dummy_model
5652

53+
(* public model *)
54+
let model = state
55+
5756
let update_simulation_state (simulation_state : simulation_state) : unit =
5857
let () = set_state { simulation_state } in
5958
()
6059

61-
let model : model React.signal = state
62-
6360
let eval_with_sim_manager :
6461
'a.
6562
label:string ->

‎gui/state/state_simulation.mli‎

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -8,18 +8,14 @@
88

99
type t
1010

11-
val t_simulation_info : t -> Api_types_j.simulation_info option
11+
val get_simulation_info : t -> Api_types_j.simulation_info option
12+
val dummy_model : t
13+
val model : t React.signal
1214

13-
type model = t
15+
type simulation_status = STOPPED | INITALIZING | RUNNING | PAUSED
1416

15-
val dummy_model : model
16-
val model : model React.signal
17-
val model_simulation_info : model -> Api_types_j.simulation_info option
18-
19-
type model_state = STOPPED | INITALIZING | RUNNING | PAUSED
20-
21-
val model_state_to_string : model_state -> string
22-
val model_simulation_state : t -> model_state
17+
val simulation_status_to_string : simulation_status -> string
18+
val model_simulation_state : t -> simulation_status
2319

2420
(* run on application init *)
2521
val init : unit -> unit Lwt.t

‎gui/ui/panel_preferences.ml‎

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@ open Lwt.Infix
1111
open List_util.Infix
1212

1313
let visible_on_states ?(a_class = [])
14-
(state : State_simulation.model_state list) : string list React.signal =
14+
(state : State_simulation.simulation_status list) : string list React.signal
15+
=
1516
let hidden_class = [ "hidden" ] in
1617
let visible_class = [ "visible" ] in
1718
React.S.bind State_simulation.model (fun model ->
@@ -551,7 +552,7 @@ module DivStatusIndicator : Ui_common.Div = struct
551552
Tyxml_js.R.Html.txt
552553
(React.S.bind State_simulation.model (fun model ->
553554
let label =
554-
State_simulation.model_state_to_string
555+
State_simulation.simulation_status_to_string
555556
(State_simulation.model_simulation_state model)
556557
in
557558
React.S.const label));
@@ -589,7 +590,7 @@ module RunningPanelLayout : Ui_common.Div = struct
589590
progress_bar
590591
(React.S.map
591592
(fun model ->
592-
let simulation_info = State_simulation.model_simulation_info model in
593+
let simulation_info = State_simulation.get_simulation_info model in
593594
let time_percent : int option =
594595
Option_util.bind
595596
(fun (status : Api_types_j.simulation_info) ->
@@ -602,7 +603,7 @@ module RunningPanelLayout : Ui_common.Div = struct
602603
State_simulation.model)
603604
(React.S.map
604605
(fun model ->
605-
let simulation_info = State_simulation.model_simulation_info model in
606+
let simulation_info = State_simulation.get_simulation_info model in
606607
let time : float option =
607608
Option_util.map
608609
(fun (status : Api_types_j.simulation_info) ->
@@ -618,7 +619,7 @@ module RunningPanelLayout : Ui_common.Div = struct
618619
progress_bar
619620
(React.S.map
620621
(fun model ->
621-
let simulation_info = State_simulation.model_simulation_info model in
622+
let simulation_info = State_simulation.get_simulation_info model in
622623
let event_percentage : int option =
623624
Option_util.bind
624625
(fun (status : Api_types_j.simulation_info) ->
@@ -633,7 +634,7 @@ module RunningPanelLayout : Ui_common.Div = struct
633634
State_simulation.model)
634635
(React.S.map
635636
(fun model ->
636-
let simulation_info = State_simulation.model_simulation_info model in
637+
let simulation_info = State_simulation.get_simulation_info model in
637638
let event : int option =
638639
Option_util.map
639640
(fun (status : Api_types_j.simulation_info) ->
@@ -665,7 +666,7 @@ module RunningPanelLayout : Ui_common.Div = struct
665666
Tyxml_js.R.Html.txt
666667
(React.S.map
667668
(fun model ->
668-
let simulation_info = State_simulation.model_simulation_info model in
669+
let simulation_info = State_simulation.get_simulation_info model in
669670
match tracked_events simulation_info with
670671
| Some tracked_events -> string_of_int tracked_events
671672
| None -> " ")
@@ -675,7 +676,7 @@ module RunningPanelLayout : Ui_common.Div = struct
675676
Tyxml_js.R.Html.txt
676677
(React.S.map
677678
(fun model ->
678-
let simulation_info = State_simulation.model_simulation_info model in
679+
let simulation_info = State_simulation.get_simulation_info model in
679680
match tracked_events simulation_info with
680681
| Some _ -> "tracked events"
681682
| None -> " ")

‎gui/ui/panel_tabs/tab_editor/subtab_influences.ml‎

Lines changed: 8 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -163,32 +163,16 @@ let recenter =
163163
]
164164
[ Html.txt "First node" ]
165165

166-
(* TODO: clean this *)
167-
let switch_class elt_id add_list remove_list =
168-
let dom_elt : 'a Js.t = Ui_common.id_dom elt_id |> Js.Unsafe.coerce in
169-
List.iter
170-
(fun (class_str : string) ->
171-
Js.Unsafe.meth_call dom_elt##.classList "add"
172-
[| Js.string class_str |> Js.Unsafe.coerce |])
173-
add_list;
174-
List.iter
175-
(fun (class_str : string) ->
176-
Js.Unsafe.meth_call dom_elt##.classList "remove"
177-
[| Js.string class_str |> Js.Unsafe.coerce |])
178-
remove_list
179-
180166
let track_cursor_switch =
181167
let track_cursor_switch_id = "track_cursor_switch_id" in
182-
let () =
183-
Hooked.S.register track_cursor (fun track_enabled ->
184-
let add_list, remove_list =
185-
if track_enabled then
186-
[ "btn-light"; "active" ], [ "btn-default" ]
187-
else
188-
[ "btn-default" ], [ "btn-light"; "active" ]
189-
in
190-
switch_class track_cursor_switch_id add_list remove_list)
191-
in
168+
Hooked.S.register track_cursor (fun track_enabled ->
169+
let add_list, remove_list =
170+
if track_enabled then
171+
[ "btn-light"; "active" ], [ "btn-default" ]
172+
else
173+
[ "btn-default" ], [ "btn-light"; "active" ]
174+
in
175+
Ui_common.switch_class track_cursor_switch_id add_list remove_list);
192176
let on_click _ =
193177
let () = track_cursor_set (not (Hooked.S.value track_cursor)) in
194178
if Hooked.S.value track_cursor then

0 commit comments

Comments
 (0)