#661 filter out KaSa messages for UI

core/api/api_common.ml

@@ -27,8 +27,8 @@ let result_error_exception
   result_error_msg ?severity ?result_code message
 
 let method_handler_errors ?severity mh =
-  let uncaught = Exception_without_parameter.get_uncaught_exception_list mh in
-  let caught = Exception_without_parameter.get_caught_exception_list mh in
+  let uncaught = Exception_without_parameter.get_uncaught_exception_list_to_ui mh in
+  let caught = Exception_without_parameter.get_caught_exception_list_to_ui mh in
   List.fold_right
     (fun x l ->
        error_msg ?severity

core/error_handlers/exception.ml

@@ -28,33 +28,34 @@ let safe_warn parameters _error_handler file_name message exn _default =
   let _ = Loggers.print_newline (Remanent_parameters.get_logger parameters) in
   raise (Exception_without_parameter.Uncaught_exception uncaught)
 
-let unsafe_warn _parameters error_handler file_name message exn default =
+let unsafe_warn
+  _parameters error_handler ?to_ui  file_name message exn default =
   let uncaught = Exception_without_parameter.build_uncaught_exception ?file_name ?message exn in
-  Exception_without_parameter.add_uncaught_error uncaught error_handler, default ()
+  Exception_without_parameter.add_uncaught_error uncaught ?to_ui error_handler, default ()
 
-let warn_aux parameters error_handler file message exn default =
+let warn_aux parameters error_handler ?to_ui file message exn default =
   let error,dft =
     if Remanent_parameters.get_unsafe parameters
-    then unsafe_warn parameters error_handler file message exn default
+    then unsafe_warn parameters error_handler ?to_ui file message exn default
     else safe_warn parameters error_handler file message exn default
   in
   let () = Remanent_parameters.save_error_list parameters error in
   error,dft
 
-let warn_with_exn parameters error_handler (file,line,_,_) ?message:(message="") ?pos:(pos=None) exn default =
+let warn_with_exn parameters error_handler ?to_ui (file,line,_,_) ?message:(message="") ?pos:(pos=None) exn default =
   let liaison = if message = "" && pos = None then "" else ": " in
   let pos =
     match pos with
     | None -> ""
     | Some s -> ", "^Locality.to_string s
   in
   warn_aux
-    parameters error_handler
+    parameters error_handler ?to_ui
     (Some file) (Some ("line "^(string_of_int line)^pos^liaison^message))
     exn default
 
-let warn parameters error_handler file_line ?message:(message="") ?pos exn default =
-  warn_with_exn parameters error_handler file_line ~message ~pos exn (fun () -> default)
+let warn parameters error_handler ?to_ui file_line ?message:(message="") ?pos exn default =
+  warn_with_exn parameters error_handler ?to_ui file_line ~message ~pos exn (fun () -> default)
 
 let print_for_KaSim parameters handlers =
   let parameters = Remanent_parameters.update_prefix parameters "error: " in
@@ -116,11 +117,12 @@ let _lift_error_logs_for_KaSa f =
               string_opt exn (fun  () -> ())))
 
 let check_point
-    (warn:Remanent_parameters_sig.parameters -> method_handler -> 'a -> ?message:string -> ?pos:Locality.t ->
-     exn -> unit -> method_handler * unit)
-    parameter error error' s ?message ?pos exn =
+    (warn:Remanent_parameters_sig.parameters -> method_handler
+          -> ?to_ui:bool -> 'a ->  ?message:string -> ?pos:Locality.t
+          -> exn -> unit -> method_handler * unit)
+    parameter error error' s ?to_ui ?message ?pos exn =
   if error==error'
   then error
   else
-    let error,() = warn parameter error' s ?message ?pos exn () in
+    let error,() = warn parameter error' ?to_ui s ?message ?pos exn () in
     error

core/error_handlers/exception.mli

@@ -6,12 +6,12 @@ val empty_error_handler : method_handler
 val is_empty_error_handler : method_handler -> bool
 
 val warn_with_exn :
-  Remanent_parameters_sig.parameters -> method_handler ->
+  Remanent_parameters_sig.parameters -> method_handler -> ?to_ui:bool ->
   string * int * int * int  -> ?message:string -> ?pos:Locality.t option ->
   exn -> (unit -> 'a) -> method_handler * 'a
 
 val warn :
-  Remanent_parameters_sig.parameters -> method_handler ->
+  Remanent_parameters_sig.parameters -> method_handler -> ?to_ui:bool ->
   string * int * int * int  -> ?message:string -> ?pos:Locality.t ->
   exn -> 'a -> method_handler * 'a
 
@@ -23,7 +23,7 @@ val wrap : Remanent_parameters_sig.parameters ->
   method_handler -> string -> string option -> exn -> method_handler
 
 val check_point :
-  (Remanent_parameters_sig.parameters -> method_handler -> 'a -> ?message:string -> ?pos:Locality.t ->
+  (Remanent_parameters_sig.parameters -> method_handler -> ?to_ui:bool -> 'a -> ?message:string -> ?pos:Locality.t ->
    exn -> unit -> method_handler * unit) ->
   Remanent_parameters_sig.parameters -> method_handler -> method_handler ->
-  'a -> ?message:string -> ?pos:Locality.t -> exn -> method_handler
+  'a -> ?to_ui:bool -> ?message:string -> ?pos:Locality.t -> exn -> method_handler

core/parameters/exception_without_parameter.ml

@@ -275,7 +275,9 @@ and stringlist_of_caught_light x stack =
 
 type method_handler = {
   mh_caught_error_list:caught_exception list;
+  mh_caught_error_list_to_ui:caught_exception list;
   mh_uncaught_error_list:uncaught_exception list;
+  mh_uncaught_error_list_to_ui:uncaught_exception list;
 }
 
 let to_json method_handler =
@@ -284,9 +286,16 @@ let to_json method_handler =
       "caught",
       JsonUtil.of_list
         caught_exception_to_json method_handler.mh_caught_error_list;
+      "caught",
+      JsonUtil.of_list
+        caught_exception_to_json method_handler.mh_caught_error_list_to_ui;
       "uncaught",
       JsonUtil.of_list
         uncaught_exception_to_json method_handler.mh_uncaught_error_list;
+      "uncaught_to_ui",
+        JsonUtil.of_list
+          uncaught_exception_to_json method_handler.mh_uncaught_error_list_to_ui;
+
     ]
 
 let of_json =
@@ -298,13 +307,23 @@ let of_json =
           (JsonUtil.to_list caught_exception_of_json)
             (List.assoc "caught" l)
         in
+        let caught_to_ui =
+          (JsonUtil.to_list caught_exception_of_json)
+            (List.assoc "caught_to_ui" l)
+        in
         let uncaught =
           (JsonUtil.to_list uncaught_exception_of_json)
             (List.assoc "uncaught" l)
         in
+        let uncaught_to_ui =
+          (JsonUtil.to_list uncaught_exception_of_json)
+            (List.assoc "uncaught_to_ui" l)
+        in
         {
           mh_caught_error_list = caught ;
+          mh_caught_error_list_to_ui = caught_to_ui ;
           mh_uncaught_error_list = uncaught ;
+          mh_uncaught_error_list_to_ui = uncaught_to_ui ;
         }
       with
       | _ ->
@@ -317,12 +336,27 @@ let of_json =
 let empty_error_handler =
   {
     mh_caught_error_list=[];
+    mh_caught_error_list_to_ui=[];
     mh_uncaught_error_list=[];
+    mh_uncaught_error_list_to_ui=[];
   }
 
-let add_uncaught_error uncaught error = {error with mh_uncaught_error_list = uncaught::error.mh_uncaught_error_list}
+let add_uncaught_error_to_ui uncaught error = {error with mh_uncaught_error_list_to_ui = uncaught::error.mh_uncaught_error_list_to_ui}
+let add_uncaught_error_to_others uncaught error = {error with mh_uncaught_error_list = uncaught::error.mh_uncaught_error_list}
+
+let add_uncaught_error ?to_ui uncaught error =
+  let error =
+    match to_ui with
+      | Some false | None -> error
+      | Some true -> add_uncaught_error_to_ui uncaught error
+  in
+  add_uncaught_error_to_others uncaught error
+
+
+
 let get_caught_exception_list error = error.mh_caught_error_list
+let get_caught_exception_list_to_ui error = error.mh_caught_error_list_to_ui
 let get_uncaught_exception_list error = error.mh_uncaught_error_list
-
+let get_uncaught_exception_list_to_ui error = error.mh_uncaught_error_list_to_ui
 let is_empty_error_handler x =
   x.mh_caught_error_list=[] && x.mh_uncaught_error_list=[]

core/parameters/exception_without_parameter.mli

@@ -24,7 +24,7 @@ type method_handler
 val raise_exception: string option -> unit -> string option -> exn -> unit
 val build_uncaught_exception: ?file_name:string -> ?message:string -> exn -> uncaught_exception
 val build_caught_exception: string option -> string option -> exn -> string list -> caught_exception
-val add_uncaught_error: uncaught_exception -> method_handler -> method_handler
+val add_uncaught_error: ?to_ui:bool -> uncaught_exception -> method_handler -> method_handler
 val stringlist_of_exception: exn -> string list -> string list
 val stringlist_of_uncaught: uncaught_exception -> string list -> string list
 val stringlist_of_caught: caught_exception -> string list -> string list
@@ -38,7 +38,9 @@ val empty_error_handler: method_handler
 val is_empty_error_handler: method_handler -> bool
 
 val get_caught_exception_list: method_handler -> caught_exception list
+val get_caught_exception_list_to_ui: method_handler -> caught_exception list
 val get_uncaught_exception_list: method_handler -> uncaught_exception list
+val get_uncaught_exception_list_to_ui: method_handler -> uncaught_exception list
 
 val to_json: method_handler -> Yojson.Basic.t
 val of_json: Yojson.Basic.t -> method_handler