print conditions for rule and agent deadness in the GUI

Author: reb-ddm

gui/lib/html_utility.ml

@@ -122,7 +122,7 @@ let print_formula_option formula list =
   | Some formula ->
     let list = print_string "]" list in
     let list = print_formula formula list in
-    print_string "[ only if " list
+    print_string "[only if " list
 
 let print_exceptions_caught_and_uncaught mh =
   let uncaught = Exception_without_parameter.get_uncaught_exception_list mh in
@@ -145,4 +145,20 @@ let print_exceptions_caught_and_uncaught mh =
            ])
        uncaught)
 
-let print_rule _rule list = print_string "" list (*TODO*)
+let string_of_rule rule =
+  if rule.Public_data.rule_label <> "" then
+    " '" ^ rule.Public_data.rule_label ^ "'"
+  else if rule.Public_data.rule_ast <> "" then
+    rule.Public_data.rule_ast
+  else
+    string_of_int rule.Public_data.rule_id
+
+let print_rule rule list = print_string (string_of_rule rule) list
+
+let string_of_agent agent =
+  if agent.Public_data.agent_ast <> "" then
+    agent.Public_data.agent_ast
+  else
+    string_of_int agent.Public_data.agent_id
+
+let print_agent_kind agent list = print_string (string_of_agent agent) list

gui/lib/html_utility.mli

@@ -13,16 +13,6 @@ val print_newline : ([> `PCDATA ] as 'a) Html.elt list -> 'a Html.elt list
 val print_string :
   string Html.wrap -> ([> `PCDATA ] as 'a) Html.elt list -> 'a Html.elt list
 
-val print_agent :
-  string Html.wrap
-  * (string Html.wrap
-    * string Html.wrap option
-    * Public_data.binding_state option
-    * (int option * int option) option)
-    list ->
-  ([> `PCDATA ] as 'a) Html.elt list ->
-  'a Html.elt list
-
 val print_site_graph :
   (string Html.wrap
   * (string Html.wrap
@@ -48,5 +38,14 @@ val print_exceptions_caught_and_uncaught :
   Exception_without_parameter.exceptions_caught_and_uncaught ->
   [> Html_types.p ] Html.elt list
 
+val string_of_rule : Public_data.rule -> string
+
 val print_rule :
   Public_data.rule -> ([> `PCDATA ] as 'a) Html.elt list -> 'a Html.elt list
+
+val string_of_agent : Public_data.agent_kind -> string
+
+val print_agent_kind :
+  Public_data.agent_kind ->
+  ([> `PCDATA ] as 'a) Html.elt list ->
+  'a Html.elt list

gui/ui/panel_tabs/tab_editor/subtab_constraints.ml

@@ -8,6 +8,7 @@
 
 module Html = Tyxml_js.Html5
 open Lwt.Infix
+open Lwt.Syntax
 
 let navli () = ReactiveData.RList.empty
 let tab_is_active, set_tab_is_active = React.S.create false
@@ -28,10 +29,10 @@ let content () =
       match conclusion with
       | [ (site_graph, formula) ] ->
         let list =
-          Html_utility.print_site_graph site_graph
+          Html_utility.print_formula_option formula
             (Html_utility.print_newline list)
         in
-        Html_utility.print_formula_option formula list
+        Html_utility.print_site_graph site_graph list
       | _ :: _ | [] ->
         let list = Html_utility.print_newline list in
         let list = Html_utility.print_string " ]" list in
@@ -57,26 +58,56 @@ let content () =
     let list = Html_utility.print_site_graph hyp list in
     list
   in
+  let print_conditionally_dead_agents
+      ((agent : Public_data.agent_kind), formula) list =
+    let list = Html_utility.print_newline list in
+    let list = Html_utility.print_formula formula list in
+    let list = Html_utility.print_string " can occur in the model if " list in
+    Html_utility.print_agent_kind agent list
+  in
+  let print_conditionally_dead_rules ((rule : Public_data.rule), formula) list =
+    let list = Html_utility.print_newline list in
+    let list = Html_utility.print_formula formula list in
+    let list = Html_utility.print_string " could be applied if " list in
+    Html_utility.print_rule rule list
+  in
+
+  let print_panel header print_function content =
+    let texts =
+      List.fold_left (fun list c -> print_function c list) [] content
+    in
+    let title =
+      Html.div ~a:[ Html.a_class [ "panel-heading" ] ] [ Html.txt header ]
+    in
+    let content =
+      Html.div ~a:[ Html.a_class [ "panel-body"; "panel-pre" ] ] texts
+    in
+    Html.div ~a:[ Html.a_class [ "panel"; "panel-default" ] ] [ title; content ]
+  in
   let add_constraints constraints =
     List.fold_left
       (fun panels (a, b) ->
-        let texts =
-          List.fold_left
-            (fun list lemma -> print_refinement_constraint lemma list)
-            [] (List.rev b)
-        in
-        let title =
-          Html.div ~a:[ Html.a_class [ "panel-heading" ] ] [ Html.txt a ]
-        in
-        let content =
-          Html.div ~a:[ Html.a_class [ "panel-body"; "panel-pre" ] ] texts
-        in
-        Html.div
-          ~a:[ Html.a_class [ "panel"; "panel-default" ] ]
-          [ title; content ]
-        :: panels)
+        print_panel a print_refinement_constraint b :: panels)
       [] constraints
   in
+  let add_rules
+      (conditionally_dead_rules : Public_data.rule_deadness_conditions) =
+    if List.length conditionally_dead_rules > 0 then
+      print_panel "Conditions for rule deadness" print_conditionally_dead_rules
+        conditionally_dead_rules
+      :: []
+    else
+      [ Html.div [] ]
+  in
+  let add_agents
+      (conditionally_dead_agents : Public_data.agent_deadness_conditions) =
+    if List.length conditionally_dead_agents > 0 then
+      print_panel "Conditions for agent deadness"
+        print_conditionally_dead_agents conditionally_dead_agents
+      :: []
+    else
+      [ Html.div [] ]
+  in
   let print_error_message r =
     let title =
       Html.div
@@ -104,8 +135,19 @@ let content () =
   let constraints_div =
     State_project.on_project_change_async ~on:tab_is_active ()
       (React.S.const ()) [] (fun (manager : Api.concrete_manager) () ->
-        manager#get_constraints_list
-        >|= Result_util.fold ~ok:add_constraints ~error:print_error_message)
+        let* out_constraints =
+          manager#get_constraints_list
+          >|= Result_util.fold ~ok:add_constraints ~error:print_error_message
+        in
+        let* out_rules =
+          manager#get_conditionally_dead_rules
+          >|= Result_util.fold ~ok:add_rules ~error:print_error_message
+        in
+        let* out_agents =
+          manager#get_conditionally_dead_agents
+          >|= Result_util.fold ~ok:add_agents ~error:print_error_message
+        in
+        Lwt.return (out_constraints @ out_rules @ out_agents))
   in
   [
     Tyxml_js.R.Html5.div

gui/ui/panel_tabs/tab_editor/tab_editor.ml

@@ -94,14 +94,7 @@ let init_dead_rules () =
                                acc
                              else (
                                let text =
-                                 "Dead rule "
-                                 ^
-                                 if rule.Public_data.rule_label <> "" then
-                                   " '" ^ rule.Public_data.rule_label ^ "'"
-                                 else if rule.Public_data.rule_ast <> "" then
-                                   rule.Public_data.rule_ast
-                                 else
-                                   string_of_int rule.Public_data.rule_id
+                                 "Dead rule " ^ Html_utility.string_of_rule rule
                                in
                                {
                                  Result_util.severity = Logs.Warning;
@@ -138,11 +131,7 @@ let init_dead_agents () =
                            (fun acc agent ->
                              let text =
                                "Dead agent "
-                               ^
-                               if agent.Public_data.agent_ast <> "" then
-                                 agent.Public_data.agent_ast
-                               else
-                                 string_of_int agent.Public_data.agent_id
+                               ^ Html_utility.string_of_agent agent
                              in
                              List.fold_left
                                (fun acc range ->