Commit c7e7758a authored by Sylvain Dailler's avatar Sylvain Dailler
Browse files

Parsing error dont go through Error where they are catched by a debug flag.

They are always printed with new message Parse_Or_Type_Error.
File_contents and Get_file added where missing.
Indentation updated in json_util
parent 8d009126
...@@ -898,6 +898,7 @@ let treat_message_notification msg = match msg with ...@@ -898,6 +898,7 @@ let treat_message_notification msg = match msg with
| Information s -> print_message "%s" s | Information s -> print_message "%s" s
| Task_Monitor (t, s, r) -> update_monitor t s r | Task_Monitor (t, s, r) -> update_monitor t s r
| Open_File_Error s -> print_message "%s" s | Open_File_Error s -> print_message "%s" s
| Parse_Or_Type_Error s -> print_message "%s" s
| Error s -> | Error s ->
if Debug.test_flag debug then if Debug.test_flag debug then
print_message "%s" s print_message "%s" s
......
...@@ -32,6 +32,7 @@ type message_notification = ...@@ -32,6 +32,7 @@ type message_notification =
| Help of string | Help of string
| Information of string | Information of string
| Task_Monitor of int * int * int | Task_Monitor of int * int * int
| Parse_Or_Type_Error of string
| Error of string | Error of string
| Open_File_Error of string | Open_File_Error of string
......
...@@ -35,6 +35,8 @@ type message_notification = ...@@ -35,6 +35,8 @@ type message_notification =
| Information of string | Information of string
(* Number of task scheduled, running, etc *) (* Number of task scheduled, running, etc *)
| Task_Monitor of int * int * int | Task_Monitor of int * int * int
(* A file was read or reloaded and now contains a parsing or typing error *)
| Parse_Or_Type_Error of string
(* An error happened that could not be identified in server *) (* An error happened that could not be identified in server *)
| Error of string | Error of string
| Open_File_Error of string | Open_File_Error of string
......
...@@ -304,6 +304,7 @@ let print_msg fmt m = ...@@ -304,6 +304,7 @@ let print_msg fmt m =
| Help _s -> fprintf fmt "help" | Help _s -> fprintf fmt "help"
| Information s -> fprintf fmt "info %s" s | Information s -> fprintf fmt "info %s" s
| Task_Monitor _ -> fprintf fmt "task montor" | Task_Monitor _ -> fprintf fmt "task montor"
| Parse_Or_Type_Error s -> fprintf fmt "parse_or_type_error:\n %s" s
| Error s -> fprintf fmt "%s" s | Error s -> fprintf fmt "%s" s
| Open_File_Error s -> fprintf fmt "%s" s | Open_File_Error s -> fprintf fmt "%s" s
...@@ -334,25 +335,25 @@ module Make (S:Controller_itp.Scheduler) (P:Protocol) = struct ...@@ -334,25 +335,25 @@ module Make (S:Controller_itp.Scheduler) (P:Protocol) = struct
try cont_from_session_dir cont f; true with try cont_from_session_dir cont f; true with
| e -> | e ->
let s = Format.asprintf "%a@." Exn_printer.exn_printer e in let s = Format.asprintf "%a@." Exn_printer.exn_printer e in
P.notify (Message (Error s)); false P.notify (Message (Parse_Or_Type_Error s)); false
let cont_from_file cont f = let cont_from_file cont f =
try cont_from_file cont f; true with try cont_from_file cont f; true with
| e -> | e ->
let s = Format.asprintf "%a@." Exn_printer.exn_printer e in let s = Format.asprintf "%a@." Exn_printer.exn_printer e in
P.notify (Message (Error s)); false P.notify (Message (Parse_Or_Type_Error s)); false
let reload_files cont ~use_shapes = let reload_files cont ~use_shapes =
try reload_files cont ~use_shapes; true with try reload_files cont ~use_shapes; true with
| e -> | e ->
let s = Format.asprintf "%a@." Exn_printer.exn_printer e in let s = Format.asprintf "%a@." Exn_printer.exn_printer e in
P.notify (Message (Error s)); false P.notify (Message (Parse_Or_Type_Error s)); false
let add_file c ?format fname = let add_file c ?format fname =
try add_file c ?format fname; true with try add_file c ?format fname; true with
| e -> | e ->
let s = Format.asprintf "%a@." Exn_printer.exn_printer e in let s = Format.asprintf "%a@." Exn_printer.exn_printer e in
P.notify (Message (Error s)); false P.notify (Message (Parse_Or_Type_Error s)); false
let debug = Debug.register_flag "itp_server" ~desc:"ITP server" let debug = Debug.register_flag "itp_server" ~desc:"ITP server"
...@@ -715,9 +716,9 @@ module Make (S:Controller_itp.Scheduler) (P:Protocol) = struct ...@@ -715,9 +716,9 @@ module Make (S:Controller_itp.Scheduler) (P:Protocol) = struct
} }
in in
try ( try (
if (Sys.file_exists f) then if Sys.file_exists f then
begin begin
if (Sys.is_directory f) then if Sys.is_directory f then
begin begin
let b = cont_from_session_dir d.cont f in let b = cont_from_session_dir d.cont f in
if b then if b then
......
...@@ -85,14 +85,15 @@ let convert_update u = ...@@ -85,14 +85,15 @@ let convert_update u =
let convert_notification_constructor n = let convert_notification_constructor n =
match n with match n with
| New_node _ -> String "New_node" | New_node _ -> String "New_node"
| Node_change _ -> String "Node_change" | Node_change _ -> String "Node_change"
| Remove _ -> String "Remove" | Remove _ -> String "Remove"
| Initialized _ -> String "Initialized" | Initialized _ -> String "Initialized"
| Saved -> String "Saved" | Saved -> String "Saved"
| Message _ -> String "Message" | Message _ -> String "Message"
| Dead _ -> String "Dead" | Dead _ -> String "Dead"
| Task _ -> String "Task" | Task _ -> String "Task"
| File_contents _ -> String "File_contents"
let convert_node_type_string nt = let convert_node_type_string nt =
match nt with match nt with
...@@ -115,6 +116,7 @@ let convert_request_constructor (r: ide_request) = ...@@ -115,6 +116,7 @@ let convert_request_constructor (r: ide_request) =
| Open_session_req _ -> String "Open_session_req" | Open_session_req _ -> String "Open_session_req"
| Add_file_req _ -> String "Add_file_req" | Add_file_req _ -> String "Add_file_req"
| Set_max_tasks_req _ -> String "Set_max_tasks_req" | Set_max_tasks_req _ -> String "Set_max_tasks_req"
| Get_file_contents _ -> String "Get_file_contents"
| Get_task _ -> String "Get_task" | Get_task _ -> String "Get_task"
| Remove_subtree _ -> String "Remove_subtree" | Remove_subtree _ -> String "Remove_subtree"
| Copy_paste _ -> String "Copy_paste" | Copy_paste _ -> String "Copy_paste"
...@@ -130,44 +132,47 @@ let print_request_to_json (r: ide_request): Json_base.value = ...@@ -130,44 +132,47 @@ let print_request_to_json (r: ide_request): Json_base.value =
match r with match r with
| Command_req (nid, s) -> | Command_req (nid, s) ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int nid; "node_ID", Int nid;
"command", String s] "command", String s]
| Prove_req (nid, p, l) -> | Prove_req (nid, p, l) ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int nid; "node_ID", Int nid;
"prover", String p; "prover", String p;
"limit", convert_limit l] "limit", convert_limit l]
| Transform_req (nid, tr, args) -> | Transform_req (nid, tr, args) ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int nid; "node_ID", Int nid;
"transformation", String tr; "transformation", String tr;
"arguments", Array (List.map (fun x -> String x) args)] "arguments", Array (List.map (fun x -> String x) args)]
| Strategy_req (nid, str) -> | Strategy_req (nid, str) ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int nid; "node_ID", Int nid;
"strategy", String str] "strategy", String str]
| Open_session_req f -> | Open_session_req f ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"file", String f] "file", String f]
| Add_file_req f -> | Add_file_req f ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"file", String f] "file", String f]
| Set_max_tasks_req n -> | Set_max_tasks_req n ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"tasks", Int n] "tasks", Int n]
| Get_task n -> | Get_task n ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int n] "node_ID", Int n]
| Get_file_contents s ->
Obj ["ide_request", cc r;
"file", String s]
| Remove_subtree n -> | Remove_subtree n ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int n] "node_ID", Int n]
| Copy_paste (from_id, to_id) -> | Copy_paste (from_id, to_id) ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int from_id; "node_ID", Int from_id;
"node_ID", Int to_id] "node_ID", Int to_id]
| Copy_detached from_id -> | Copy_detached from_id ->
Obj ["ide_request", cc r; Obj ["ide_request", cc r;
"node_ID", Int from_id] "node_ID", Int from_id]
| Get_Session_Tree_req -> | Get_Session_Tree_req ->
Obj ["ide_request", cc r] Obj ["ide_request", cc r]
| Save_req -> | Save_req ->
...@@ -181,17 +186,18 @@ let print_request_to_json (r: ide_request): Json_base.value = ...@@ -181,17 +186,18 @@ let print_request_to_json (r: ide_request): Json_base.value =
let convert_constructor_message (m: message_notification) = let convert_constructor_message (m: message_notification) =
match m with match m with
| Proof_error _ -> String "Proof_error" | Proof_error _ -> String "Proof_error"
| Transf_error _ -> String "Transf_error" | Transf_error _ -> String "Transf_error"
| Strat_error _ -> String "Strat_error" | Strat_error _ -> String "Strat_error"
| Replay_Info _ -> String "Replay_Info" | Replay_Info _ -> String "Replay_Info"
| Query_Info _ -> String "Query_Info" | Query_Info _ -> String "Query_Info"
| Query_Error _ -> String "Query_Error" | Query_Error _ -> String "Query_Error"
| Help _ -> String "Help" | Help _ -> String "Help"
| Information _ -> String "Information" | Information _ -> String "Information"
| Task_Monitor _ -> String "Task_Monitor" | Task_Monitor _ -> String "Task_Monitor"
| Error _ -> String "Error" | Parse_Or_Type_Error _ -> String "Parse_Or_Type_Error"
| Open_File_Error _ -> String "Open_File_Error" | Error _ -> String "Error"
| Open_File_Error _ -> String "Open_File_Error"
let convert_message (m: message_notification) = let convert_message (m: message_notification) =
...@@ -199,75 +205,82 @@ let convert_message (m: message_notification) = ...@@ -199,75 +205,82 @@ let convert_message (m: message_notification) =
match m with match m with
| Proof_error (nid, s) -> | Proof_error (nid, s) ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"node_ID", Int nid; "node_ID", Int nid;
"error", String s] "error", String s]
| Transf_error (nid, s) -> | Transf_error (nid, s) ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"node_ID", Int nid; "node_ID", Int nid;
"error", String s] "error", String s]
| Strat_error (nid, s) -> | Strat_error (nid, s) ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"node_ID", Int nid; "node_ID", Int nid;
"error", String s] "error", String s]
| Replay_Info s -> | Replay_Info s ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"replay_info", String s] "replay_info", String s]
| Query_Info (nid, s) -> | Query_Info (nid, s) ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"node_ID", Int nid; "node_ID", Int nid;
"qinfo", String s] "qinfo", String s]
| Query_Error (nid, s) -> | Query_Error (nid, s) ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"node_ID", Int nid; "node_ID", Int nid;
"qerror", String s] "qerror", String s]
| Help s -> | Help s ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"qhelp", String s] "qhelp", String s]
| Information s -> | Information s ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"information", String s] "information", String s]
| Task_Monitor (n, k, p) -> | Task_Monitor (n, k, p) ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"monitor", Array [Int n; Int k; Int p]] "monitor", Array [Int n; Int k; Int p]]
| Parse_Or_Type_Error s ->
Obj ["mess_notif", cc m;
"error", String s]
| Error s -> | Error s ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"error", String s] "error", String s]
| Open_File_Error s -> | Open_File_Error s ->
Obj ["mess_notif", cc m; Obj ["mess_notif", cc m;
"open_error", String s] "open_error", String s]
let print_notification_to_json (n: notification): Json_base.value = let print_notification_to_json (n: notification): Json_base.value =
let cc = convert_notification_constructor in let cc = convert_notification_constructor in
match n with match n with
| New_node (nid, parent, node_type, name, detached) -> | New_node (nid, parent, node_type, name, detached) ->
Obj ["notification", cc n; Obj ["notification", cc n;
"node_ID", Int nid; "node_ID", Int nid;
"parent_ID", Int parent; "parent_ID", Int parent;
"node_type", convert_node_type node_type; "node_type", convert_node_type node_type;
"name", String name; "name", String name;
"detached", Bool detached] "detached", Bool detached]
| Node_change (nid, update) -> | Node_change (nid, update) ->
Obj ["notification", cc n; Obj ["notification", cc n;
"node_ID", Int nid; "node_ID", Int nid;
"update", convert_update update] "update", convert_update update]
| Remove nid -> | Remove nid ->
Obj ["notification", cc n; Obj ["notification", cc n;
"node_ID", Int nid] "node_ID", Int nid]
| Initialized infos -> | Initialized infos ->
Obj ["notification", cc n; Obj ["notification", cc n;
"infos", convert_infos infos] "infos", convert_infos infos]
| Saved -> | Saved ->
Obj ["notification", cc n] Obj ["notification", cc n]
| Message m -> | Message m ->
Obj ["notification", cc n; Obj ["notification", cc n;
"message", convert_message m] "message", convert_message m]
| Dead s -> | Dead s ->
Obj ["notification", cc n; Obj ["notification", cc n;
"message", String s] "message", String s]
| Task (nid, s) -> | Task (nid, s) ->
Obj ["notification", cc n; Obj ["notification", cc n;
"node_ID", Int nid; "node_ID", Int nid;
"task", String s] "task", String s]
| File_contents (f, s) ->
Obj ["notification", cc n;
"file", String f;
"content", String s]
let print_notification fmt (n: notification) = let print_notification fmt (n: notification) =
Format.fprintf fmt "%a" Json_base.print (print_notification_to_json n) Format.fprintf fmt "%a" Json_base.print (print_notification_to_json n)
......
...@@ -109,6 +109,7 @@ g -> print the current task\n\ ...@@ -109,6 +109,7 @@ g -> print the current task\n\
p -> print the session@." s p -> print the session@." s
| Information s -> fprintf fmt "%s@." s | Information s -> fprintf fmt "%s@." s
| Task_Monitor (_t, _s, _r) -> () (* TODO do we want to print something for this? *) | Task_Monitor (_t, _s, _r) -> () (* TODO do we want to print something for this? *)
| Parse_Or_Type_Error s -> fprintf fmt "%s@." s
| Error s -> | Error s ->
fprintf fmt "%s@." s fprintf fmt "%s@." s
| Open_File_Error s -> fprintf fmt "%s@." s | Open_File_Error s -> fprintf fmt "%s@." s
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment