Renaming and comment in state_simulation.mli

gui/JsNode.ml

@@ -56,7 +56,9 @@ let spawn_process (configuration : process_configuration Js.t) :
     (Js.Unsafe.js_expr "spawnProcess")
     [| Js.Unsafe.inject configuration |]
 
-let launch_agent onClose message_delimiter command args handler =
+let launch_agent (onClose : unit -> unit) (message_delimiter : char)
+    (command : string) (args : string list) (handler : string -> unit) :
+    < kill : unit Js.meth ; write : Js.js_string Js.t -> unit Js.meth > Js.t =
   let buffer = Buffer.create 512 in
   let rec onStdout msg =
     match Tools.string_split_on_char message_delimiter (Js.to_string msg) with

gui/JsSim.ml

@@ -6,7 +6,7 @@
 (* |_|\_\ * GNU Lesser General Public License Version 3                       *)
 (******************************************************************************)
 
-let onload _ =
+let onload (_ : 'a) : bool Js.t =
   let () = State_ui.onload () in
   let main = Ui_common.id_dom "main" in
   let () =

gui/panel_settings.ml

@@ -754,7 +754,7 @@ module RunningPanelLayout : Ui_common.Div = struct
         [
           Lwt_react.S.map_s
             (fun _ ->
-              State_simulation.with_simulation_info ~label:__LOC__
+              State_simulation.eval_with_sim_manager_and_info ~label:__LOC__
                 ~ready:(fun manager status ->
                   manager#simulation_efficiency
                   >>= Api_common.result_bind_lwt ~ok:(fun eff ->

gui/panel_settings_controller.ml

@@ -78,7 +78,7 @@ let focus_range (range : Loc.t) : unit =
       >>= fun _ -> Lwt.return_unit)
 
 let simulation_trace () =
-  State_simulation.when_ready ~label:__LOC__ (fun manager ->
+  State_simulation.eval_when_ready ~label:__LOC__ (fun manager ->
       State_error.wrap __LOC__ manager#simulation_raw_trace
       >>= Api_common.result_bind_lwt ~ok:(fun data_string ->
               let data = Js.string data_string in
@@ -89,7 +89,7 @@ let simulation_trace () =
               Lwt.return (Result_util.ok ())))
 
 let simulation_outputs () =
-  State_simulation.when_ready ~label:__LOC__ (fun manager ->
+  State_simulation.eval_when_ready ~label:__LOC__ (fun manager ->
       State_error.wrap __LOC__ manager#simulation_outputs_zip
       >>= Api_common.result_bind_lwt ~ok:(fun data_bigstring ->
               let data = Typed_array.Bigstring.to_arrayBuffer data_bigstring in

gui/state_file.ml

@@ -62,7 +62,7 @@ let with_current_file f =
 let get_file () : (string * string) Api.result Lwt.t =
   with_current_file (fun _state active -> function
     | { local = None; name } ->
-      State_project.with_project ~label:"get_file" (fun manager ->
+      State_project.eval_with_project ~label:"get_file" (fun manager ->
           manager#file_get name
           >>= Api_common.result_bind_lwt ~ok:(fun (text, rank') ->
                   if active.rank = rank' then
@@ -109,7 +109,7 @@ let update_directory ~reset current catalog =
 
 let create_file ~(filename : string) ~(content : string) : unit Api.result Lwt.t
     =
-  State_project.with_project ~label:"create_file" (fun manager ->
+  State_project.eval_with_project ~label:"create_file" (fun manager ->
       manager#file_catalog
       >>= Api_common.result_bind_lwt ~ok:(fun catalog ->
               let matching_file =
@@ -162,7 +162,7 @@ let rec choose_file choice = function
 
 let select_file (filename : string) (line : int option) : unit Api.result Lwt.t
     =
-  State_project.with_project ~label:"select_file" (fun manager ->
+  State_project.eval_with_project ~label:"select_file" (fun manager ->
       manager#file_catalog
       >>= Api_common.result_bind_lwt ~ok:(fun catalog ->
               Api_common.result_bind_lwt
@@ -204,7 +204,7 @@ let set_content (content : string) : unit Api.result Lwt.t =
             directory = state.directory;
           }
       in
-      State_project.with_project ~label:"set_content" (fun manager ->
+      State_project.eval_with_project ~label:"set_content" (fun manager ->
           manager#file_update name content))
 
 let set_compile file_id (compile : bool) : unit Api.result Lwt.t =
@@ -221,15 +221,15 @@ let set_compile file_id (compile : bool) : unit Api.result Lwt.t =
         Mods.IntMap.add rank { local = None; name } state.directory
       in
       let () = set_directory_state { current = state.current; directory } in
-      State_project.with_project ~label:"set_compile" (fun manager ->
+      State_project.eval_with_project ~label:"set_compile" (fun manager ->
           manager#file_create rank name content)
     ) else
       Lwt.return (Result_util.ok ())
   | Some (rank, { local = None; name }) ->
     if compile then
       Lwt.return (Result_util.ok ())
     else
-      State_project.with_project ~label:"set_compile" (fun manager ->
+      State_project.eval_with_project ~label:"set_compile" (fun manager ->
           manager#file_get name
           >>= Api_common.result_bind_lwt ~ok:(fun (content, rank') ->
                   if rank = rank' then (
@@ -241,7 +241,7 @@ let set_compile file_id (compile : bool) : unit Api.result Lwt.t =
                     let () =
                       set_directory_state { current = state.current; directory }
                     in
-                    State_project.with_project ~label:"set_compile'"
+                    State_project.eval_with_project ~label:"set_compile'"
                       (fun manager -> manager#file_delete name)
                   ) else (
                     let error_msg =
@@ -264,7 +264,7 @@ let remove_file () : unit Api.result Lwt.t =
       match local with
       | Some _ -> x
       | None ->
-        State_project.with_project ~label:"remove_file" (fun manager ->
+        State_project.eval_with_project ~label:"remove_file" (fun manager ->
             manager#file_delete name >>= fun y ->
             x >>= fun x -> Lwt.return (Api_common.result_combine [ x; y ])))
 
@@ -286,7 +286,7 @@ let do_a_move state file_id rank =
       | x -> x
     in
     if local = None then
-      State_project.with_project ~label:"remove_file" (fun manager ->
+      State_project.eval_with_project ~label:"remove_file" (fun manager ->
           manager#file_move rank file_id
           >>= Api_common.result_bind_lwt ~ok:(fun () ->
                   Lwt.return (Result_util.ok { current; directory })))
@@ -346,7 +346,7 @@ let out_of_sync out_of_sync =
       }
 
 let sync ?(reset = false) () : unit Api.result Lwt.t =
-  State_project.with_project ~label:"select_file" (fun manager ->
+  State_project.eval_with_project ~label:"select_file" (fun manager ->
       manager#file_catalog
       >>= Api_common.result_bind_lwt ~ok:(fun catalog ->
               let cand = (React.S.value model).current in

gui/state_project.ml

@@ -543,7 +543,7 @@ let init existing_projects : unit Lwt.t =
   in
   add_projects existing_projects >>= fun () -> add_projects projects
 
-let with_project :
+let eval_with_project :
       'a.
       label:string ->
       (Api.concrete_manager -> 'a Api.result Lwt.t) ->

gui/state_project.mli

@@ -48,7 +48,7 @@ val init : string list -> unit Lwt.t
 val sync : unit -> unit Api.result Lwt.t
 (* to sync state of application with runtime *)
 
-val with_project :
+val eval_with_project :
   label:string ->
   (Api.concrete_manager -> 'a Api.result Lwt.t) ->
   'a Api.result Lwt.t

gui/state_simulation.ml

@@ -60,18 +60,18 @@ let update_simulation_state (simulation_state : simulation_state) : unit =
 
 let model : model React.signal = state
 
-let with_simulation :
+let eval_with_sim_manager :
       'a.
       label:string ->
       (Api.concrete_manager -> t -> 'a Api.result Lwt.t) ->
       'a Api.result Lwt.t =
  fun ~label handler ->
   let project_handler manager = handler manager (React.S.value state) in
-  State_project.with_project ~label project_handler
+  State_project.eval_with_project ~label project_handler
 
 let fail_lwt error_msg = Lwt.return (Api_common.result_error_msg error_msg)
 
-let with_simulation_info ~(label : string)
+let eval_with_sim_manager_and_info ~(label : string)
     ?(stopped : Api.concrete_manager -> 'a Api.result Lwt.t =
       fun _ -> fail_lwt "Simulation stopped")
     ?(initializing : Api.concrete_manager -> 'a Api.result Lwt.t =
@@ -80,18 +80,18 @@ let with_simulation_info ~(label : string)
         Api.concrete_manager ->
         Api_types_j.simulation_info ->
         'a Api.result Lwt.t =
-      fun _ _ -> fail_lwt "Simulation ready") () =
-  with_simulation ~label (fun manager s ->
+      fun _ _ -> fail_lwt "Simulation ready") () : 'a Api.result Lwt.t =
+  eval_with_sim_manager ~label (fun manager s ->
       match s.simulation_state with
       | SIMULATION_STATE_STOPPED -> stopped manager
       | SIMULATION_STATE_INITALIZING -> initializing manager
       | SIMULATION_STATE_READY simulation_info -> ready manager simulation_info)
 
-let when_ready ~(label : string)
+let eval_when_ready ~(label : string)
     ?(handler : unit Api.result -> unit Lwt.t = fun _ -> Lwt.return_unit)
     (operation : Api.concrete_manager -> unit Api.result Lwt.t) : unit =
   Common.async __LOC__ (fun () ->
-      with_simulation_info ~label
+      eval_with_sim_manager_and_info ~label
         ~stopped:(fun _ -> Lwt.return (Result_util.ok ()))
         ~initializing:(fun _ -> Lwt.return (Result_util.ok ()))
         ~ready:(fun manager _ : unit Api.result Lwt.t -> operation manager)
@@ -106,7 +106,7 @@ let rec sync () =
   | SIMULATION_STATE_STOPPED | SIMULATION_STATE_INITALIZING ->
     Lwt.return (Result_util.ok ())
   | SIMULATION_STATE_READY _ ->
-    State_project.with_project ~label:"sync" (fun manager ->
+    State_project.eval_with_project ~label:"sync" (fun manager ->
         (* get current directory *)
         manager#simulation_info
         >>= Api_common.result_bind_lwt ~ok:(fun simulation_info ->
@@ -125,7 +125,7 @@ let rec sync () =
                   Lwt.return (Result_util.ok ())))
 
 let refresh () =
-  State_project.with_project ~label:"sync" (fun manager ->
+  State_project.eval_with_project ~label:"sync" (fun manager ->
       (* get current directory *)
       manager#simulation_info
       >>= Result_util.fold
@@ -144,7 +144,7 @@ let refresh () =
 let init () : unit Lwt.t = Lwt.return_unit
 
 let continue_simulation (pause_condition : string) : unit Api.result Lwt.t =
-  with_simulation_info ~label:"continue_simulation"
+  eval_with_sim_manager_and_info ~label:"continue_simulation"
     ~stopped:(fun _ ->
       let error_msg : string =
         "Failed to continue simulation, simulation stopped"
@@ -161,7 +161,7 @@ let continue_simulation (pause_condition : string) : unit Api.result Lwt.t =
     ()
 
 let pause_simulation () : unit Api.result Lwt.t =
-  with_simulation_info ~label:"pause_simulation"
+  eval_with_sim_manager_and_info ~label:"pause_simulation"
     ~stopped:(fun _ ->
       let error_msg : string =
         "Failed to pause simulation, simulation stopped"
@@ -177,7 +177,7 @@ let pause_simulation () : unit Api.result Lwt.t =
     ()
 
 let stop_simulation () : unit Api.result Lwt.t =
-  with_simulation_info ~label:"stop_simulation"
+  eval_with_sim_manager_and_info ~label:"stop_simulation"
     ~stopped:(fun _ ->
       let error_msg : string =
         "Failed to pause simulation, simulation stopped"
@@ -197,7 +197,7 @@ let stop_simulation () : unit Api.result Lwt.t =
 
 let start_simulation (simulation_parameter : Api_types_j.simulation_parameter) :
     unit Api.result Lwt.t =
-  with_simulation_info ~label:"start_simulation"
+  eval_with_sim_manager_and_info ~label:"start_simulation"
     ~stopped:(fun manager ->
       let on_error error_msgs : unit Api.result Lwt.t =
         let () = update_simulation_state SIMULATION_STATE_STOPPED in
@@ -242,7 +242,7 @@ let start_simulation (simulation_parameter : Api_types_j.simulation_parameter) :
     ()
 
 let intervene_simulation (code : string) : string Api.result Lwt.t =
-  with_simulation_info ~label:"perturb_simulation"
+  eval_with_sim_manager_and_info ~label:"perturb_simulation"
     ~stopped:(fun _ ->
       let error_msg : string =
         "Failed to start simulation, simulation running"

gui/state_simulation.mli

@@ -25,21 +25,23 @@ val model_simulation_state : t -> model_state
 val init : unit -> unit Lwt.t
 val refresh : unit -> unit Api.result Lwt.t
 
-val with_simulation :
+val eval_with_sim_manager :
   label:string ->
   (Api.concrete_manager -> t -> 'a Api.result Lwt.t) ->
   'a Api.result Lwt.t
+(** [eval_with_sim_manager ~label handler] evaluates the function [handler] applied to the [concrete_manager] of current project and current [simulation_state] *)
 
-val with_simulation_info :
+val eval_with_sim_manager_and_info :
   label:string ->
   ?stopped:(Api.concrete_manager -> 'a Api.result Lwt.t) ->
   ?initializing:(Api.concrete_manager -> 'a Api.result Lwt.t) ->
   ?ready:
     (Api.concrete_manager -> Api_types_j.simulation_info -> 'a Api.result Lwt.t) ->
   unit ->
   'a Api.result Lwt.t
+(** [eval_with_sim_manager_and_info ~label ~stopped ~initializing ~ready] evaluates the function in argument matching the current [simulation_state], applied to the [concrete_manager] of current project *)
 
-val when_ready :
+val eval_when_ready :
   label:string ->
   ?handler:(unit Api.result -> unit Lwt.t) ->
   (Api.concrete_manager -> unit Api.result Lwt.t) ->

gui/tab_contact_map.ml

@@ -25,22 +25,25 @@ let extract_contact_map = function
     acc, contact
   | _ -> failwith "Wrong ugly contact_map extractor"
 
-let contactmap : Js_contact.contact_map Js.t =
+let contact_map_js : Js_contact.contact_map Js.t =
   Js_contact.create_contact_map display_id State_settings.agent_coloring
 
-let contact_map_text =
+let contact_map_text : string React.signal =
   State_project.on_project_change_async ~on:tab_is_active None accuracy "null"
-    (fun (manager : Api.concrete_manager) acc ->
+    (fun
+      (manager : Api.concrete_manager)
+      (acc : Public_data.accuracy_level option)
+    ->
       manager#get_contact_map acc
       >|= Result_util.fold
             ~error:(fun mh ->
               let () = State_error.add_error "tab_contact_map" mh in
-              let () = contactmap##clearData in
+              let () = contact_map_js##clearData in
               "null")
             ~ok:(fun contact_json ->
               let _, map_json = extract_contact_map contact_json in
               let data = Yojson.Basic.to_string map_json in
-              let () = contactmap##setData (Js.string data) in
+              let () = contact_map_js##setData (Js.string data) in
               data))
 
 let configuration : Widget_export.configuration =
@@ -129,4 +132,5 @@ let onload () =
   in
   ()
 
-let onresize () : unit = if React.S.value tab_is_active then contactmap##redraw
+let onresize () : unit =
+  if React.S.value tab_is_active then contact_map_js##redraw