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
| Information s -> print_message "%s" s
| Task_Monitor (t, s, r) -> update_monitor t s r
| Open_File_Error s -> print_message "%s" s
| Parse_Or_Type_Error s -> print_message "%s" s
| Error s ->
if Debug.test_flag debug then
print_message "%s" s
......
......@@ -32,6 +32,7 @@ type message_notification =
| Help of string
| Information of string
| Task_Monitor of int * int * int
| Parse_Or_Type_Error of string
| Error of string
| Open_File_Error of string
......
......@@ -35,6 +35,8 @@ type message_notification =
| Information of string
(* Number of task scheduled, running, etc *)
| 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 *)
| Error of string
| Open_File_Error of string
......
......@@ -304,6 +304,7 @@ let print_msg fmt m =
| Help _s -> fprintf fmt "help"
| Information s -> fprintf fmt "info %s" s
| 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
| Open_File_Error s -> fprintf fmt "%s" s
......@@ -334,25 +335,25 @@ module Make (S:Controller_itp.Scheduler) (P:Protocol) = struct
try cont_from_session_dir cont f; true with
| e ->
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 =
try cont_from_file cont f; true with
| e ->
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 =
try reload_files cont ~use_shapes; true with
| e ->
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 =
try add_file c ?format fname; true with
| e ->
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"
......@@ -715,9 +716,9 @@ module Make (S:Controller_itp.Scheduler) (P:Protocol) = struct
}
in
try (
if (Sys.file_exists f) then
if Sys.file_exists f then
begin
if (Sys.is_directory f) then
if Sys.is_directory f then
begin
let b = cont_from_session_dir d.cont f in
if b then
......
......@@ -85,14 +85,15 @@ let convert_update u =
let convert_notification_constructor n =
match n with
| New_node _ -> String "New_node"
| Node_change _ -> String "Node_change"
| Remove _ -> String "Remove"
| Initialized _ -> String "Initialized"
| Saved -> String "Saved"
| Message _ -> String "Message"
| Dead _ -> String "Dead"
| Task _ -> String "Task"
| New_node _ -> String "New_node"
| Node_change _ -> String "Node_change"
| Remove _ -> String "Remove"
| Initialized _ -> String "Initialized"
| Saved -> String "Saved"
| Message _ -> String "Message"
| Dead _ -> String "Dead"
| Task _ -> String "Task"
| File_contents _ -> String "File_contents"
let convert_node_type_string nt =
match nt with
......@@ -115,6 +116,7 @@ let convert_request_constructor (r: ide_request) =
| Open_session_req _ -> String "Open_session_req"
| Add_file_req _ -> String "Add_file_req"
| Set_max_tasks_req _ -> String "Set_max_tasks_req"
| Get_file_contents _ -> String "Get_file_contents"
| Get_task _ -> String "Get_task"
| Remove_subtree _ -> String "Remove_subtree"
| Copy_paste _ -> String "Copy_paste"
......@@ -130,44 +132,47 @@ let print_request_to_json (r: ide_request): Json_base.value =
match r with
| Command_req (nid, s) ->
Obj ["ide_request", cc r;
"node_ID", Int nid;
"command", String s]
"node_ID", Int nid;
"command", String s]
| Prove_req (nid, p, l) ->
Obj ["ide_request", cc r;
"node_ID", Int nid;
"prover", String p;
"limit", convert_limit l]
"node_ID", Int nid;
"prover", String p;
"limit", convert_limit l]
| Transform_req (nid, tr, args) ->
Obj ["ide_request", cc r;
"node_ID", Int nid;
"transformation", String tr;
"arguments", Array (List.map (fun x -> String x) args)]
"node_ID", Int nid;
"transformation", String tr;
"arguments", Array (List.map (fun x -> String x) args)]
| Strategy_req (nid, str) ->
Obj ["ide_request", cc r;
"node_ID", Int nid;
"strategy", String str]
"node_ID", Int nid;
"strategy", String str]
| Open_session_req f ->
Obj ["ide_request", cc r;
"file", String f]
"file", String f]
| Add_file_req f ->
Obj ["ide_request", cc r;
"file", String f]
"file", String f]
| Set_max_tasks_req n ->
Obj ["ide_request", cc r;
"tasks", Int n]
"tasks", Int n]
| Get_task n ->
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 ->
Obj ["ide_request", cc r;
"node_ID", Int n]
"node_ID", Int n]
| Copy_paste (from_id, to_id) ->
Obj ["ide_request", cc r;
"node_ID", Int from_id;
"node_ID", Int to_id]
"node_ID", Int from_id;
"node_ID", Int to_id]
| Copy_detached from_id ->
Obj ["ide_request", cc r;
"node_ID", Int from_id]
"node_ID", Int from_id]
| Get_Session_Tree_req ->
Obj ["ide_request", cc r]
| Save_req ->
......@@ -181,17 +186,18 @@ let print_request_to_json (r: ide_request): Json_base.value =
let convert_constructor_message (m: message_notification) =
match m with
| Proof_error _ -> String "Proof_error"
| Transf_error _ -> String "Transf_error"
| Strat_error _ -> String "Strat_error"
| Replay_Info _ -> String "Replay_Info"
| Query_Info _ -> String "Query_Info"
| Query_Error _ -> String "Query_Error"
| Help _ -> String "Help"
| Information _ -> String "Information"
| Task_Monitor _ -> String "Task_Monitor"
| Error _ -> String "Error"
| Open_File_Error _ -> String "Open_File_Error"
| Proof_error _ -> String "Proof_error"
| Transf_error _ -> String "Transf_error"
| Strat_error _ -> String "Strat_error"
| Replay_Info _ -> String "Replay_Info"
| Query_Info _ -> String "Query_Info"
| Query_Error _ -> String "Query_Error"
| Help _ -> String "Help"
| Information _ -> String "Information"
| Task_Monitor _ -> String "Task_Monitor"
| Parse_Or_Type_Error _ -> String "Parse_Or_Type_Error"
| Error _ -> String "Error"
| Open_File_Error _ -> String "Open_File_Error"
let convert_message (m: message_notification) =
......@@ -199,75 +205,82 @@ let convert_message (m: message_notification) =
match m with
| Proof_error (nid, s) ->
Obj ["mess_notif", cc m;
"node_ID", Int nid;
"error", String s]
"node_ID", Int nid;
"error", String s]
| Transf_error (nid, s) ->
Obj ["mess_notif", cc m;
"node_ID", Int nid;
"error", String s]
"node_ID", Int nid;
"error", String s]
| Strat_error (nid, s) ->
Obj ["mess_notif", cc m;
"node_ID", Int nid;
"error", String s]
"node_ID", Int nid;
"error", String s]
| Replay_Info s ->
Obj ["mess_notif", cc m;
"replay_info", String s]
"replay_info", String s]
| Query_Info (nid, s) ->
Obj ["mess_notif", cc m;
"node_ID", Int nid;
"qinfo", String s]
"node_ID", Int nid;
"qinfo", String s]
| Query_Error (nid, s) ->
Obj ["mess_notif", cc m;
"node_ID", Int nid;
"qerror", String s]
"node_ID", Int nid;
"qerror", String s]
| Help s ->
Obj ["mess_notif", cc m;
"qhelp", String s]
"qhelp", String s]
| Information s ->
Obj ["mess_notif", cc m;
"information", String s]
"information", String s]
| Task_Monitor (n, k, p) ->
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 ->
Obj ["mess_notif", cc m;
"error", String s]
"error", String s]
| Open_File_Error s ->
Obj ["mess_notif", cc m;
"open_error", String s]
"open_error", String s]
let print_notification_to_json (n: notification): Json_base.value =
let cc = convert_notification_constructor in
match n with
| New_node (nid, parent, node_type, name, detached) ->
Obj ["notification", cc n;
"node_ID", Int nid;
"parent_ID", Int parent;
"node_type", convert_node_type node_type;
"name", String name;
"detached", Bool detached]
"node_ID", Int nid;
"parent_ID", Int parent;
"node_type", convert_node_type node_type;
"name", String name;
"detached", Bool detached]
| Node_change (nid, update) ->
Obj ["notification", cc n;
"node_ID", Int nid;
"update", convert_update update]
"node_ID", Int nid;
"update", convert_update update]
| Remove nid ->
Obj ["notification", cc n;
"node_ID", Int nid]
"node_ID", Int nid]
| Initialized infos ->
Obj ["notification", cc n;
"infos", convert_infos infos]
"infos", convert_infos infos]
| Saved ->
Obj ["notification", cc n]
| Message m ->
Obj ["notification", cc n;
"message", convert_message m]
"message", convert_message m]
| Dead s ->
Obj ["notification", cc n;
"message", String s]
"message", String s]
| Task (nid, s) ->
Obj ["notification", cc n;
"node_ID", Int nid;
"task", String s]
"node_ID", Int nid;
"task", String s]
| File_contents (f, s) ->
Obj ["notification", cc n;
"file", String f;
"content", String s]
let print_notification fmt (n: notification) =
Format.fprintf fmt "%a" Json_base.print (print_notification_to_json n)
......
......@@ -109,6 +109,7 @@ g -> print the current task\n\
p -> print the session@." s
| Information s -> fprintf fmt "%s@." s
| 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 ->
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