diff --git a/src_ocaml/grewpy.ml b/src_ocaml/grewpy.ml index f83738700cee7d7df4936c76b0026e5749d3f39f..e9e8b6810c424176fca9ae400ef128d6169ecb28 100644 --- a/src_ocaml/grewpy.ml +++ b/src_ocaml/grewpy.ml @@ -1,5 +1,4 @@ open Printf -open Printf open Yojson.Basic.Util open Conllx @@ -11,12 +10,12 @@ open Grewpy_utils module Args = struct let parse () = let rec loop = function - | [] -> () - | "-d" :: tail | "--debug" :: tail -> Global.debug := true; loop tail - | "-p" :: p :: tail | "--port" :: p:: tail -> Global.port := int_of_string p; loop tail - | "-c" :: c :: tail | "--caller" :: c :: tail-> Global.caller_pid := Some c; loop tail - | x :: _ -> failwith (sprintf "[Ars.parse] don't know what to do with arg: " ^ x) - in loop (List.tl (Array.to_list Sys.argv)) + | [] -> () + | "-d" :: tail | "--debug" :: tail -> Global.debug := true; loop tail + | "-p" :: p :: tail | "--port" :: p:: tail -> Global.port := int_of_string p; loop tail + | "-c" :: c :: tail | "--caller" :: c :: tail-> Global.caller_pid := Some c; loop tail + | x :: _ -> failwith (sprintf "[Ars.parse] don't know what to do with arg: " ^ x) + in loop (List.tl (Array.to_list Sys.argv)) end @@ -52,8 +51,8 @@ let run_command request = ) with | Some graph, Some filename -> let gr = Graph.of_json_python ~config (Yojson.Basic.from_string graph) in - Yojson.Basic.to_file filename (Graph.to_json gr); - Yojson.Basic.to_string (`Assoc [("status", `String "OK"); ("data", `Null)]) + Yojson.Basic.to_file filename (Graph.to_json gr); + Yojson.Basic.to_string (`Assoc [("status", `String "OK"); ("data", `Null)]) | _ -> json_error "incomplete 'save_graph' command" end @@ -77,14 +76,14 @@ let run_command request = let files = json |> member "files" |> to_list |> filter_string in let complete_files = match directory_opt with - | None -> files - | Some dir -> List.map (fun file -> Filename.concat dir file) files in + | None -> files + | Some dir -> List.map (fun file -> Filename.concat dir file) files in let conll_corpus = Conllx_corpus.load_list ~config complete_files in let index = Global.corpus_add conll_corpus in let data = `Assoc [("index", `Int index)] in - Yojson.Basic.to_string (`Assoc [("status", `String "OK"); ("data", data)]) + Yojson.Basic.to_string (`Assoc [("status", `String "OK"); ("data", data)]) end (* ======================= corpus_get ======================= *) @@ -93,15 +92,15 @@ let run_command request = try let corpus = json |> member "corpus_index" |> to_int |> Global.corpus_get in let position = - match (json |> member "sent_id" |> to_string_option, json |> member "position" |> to_int_option) with - | (Some sent_id, _) -> - begin - match CCArray.find_idx (fun (id,_) -> id=sent_id) corpus with - | Some (i,_) -> i - | None -> raise (Error (sprintf "sent_id '%s' not found in corpus" sent_id)) - end - | (_, Some pos) -> pos - | (None, None) -> raise (Error "neither sent_id or pos in the request") in + match (json |> member "sent_id" |> to_string_option, json |> member "position" |> to_int_option) with + | (Some sent_id, _) -> + begin + match CCArray.find_idx (fun (id,_) -> id=sent_id) corpus with + | Some (i,_) -> i + | None -> raise (Error (sprintf "sent_id '%s' not found in corpus" sent_id)) + end + | (_, Some pos) -> pos + | (None, None) -> raise (Error "neither sent_id or pos in the request") in let graph = snd corpus.(position) in let data = Graph.to_json_python ~config graph in Yojson.Basic.to_string (`Assoc [("status", `String "OK"); ("data", data)]) @@ -140,18 +139,18 @@ let run_command request = let corpus = Global.corpus_get corpus_index in let matches = Array.fold_left - (fun acc (id,graph) -> - let matching_list = Graph.search_pattern ~config pattern graph in - (List.map - (fun m -> `Assoc [ - ("sent_id", `String id); - ("matching", Matching.to_json pattern graph m) - ] - ) matching_list - ) @ acc - ) [] corpus in - Yojson.Basic.to_string - (`Assoc [ + (fun acc (id,graph) -> + let matching_list = Graph.search_pattern ~config pattern graph in + (List.map + (fun m -> `Assoc [ + ("sent_id", `String id); + ("matching", Matching.to_json pattern graph m) + ] + ) matching_list + ) @ acc + ) [] corpus in + Yojson.Basic.to_string + (`Assoc [ ("status", `String "OK"); ("data", `List matches) ]) @@ -169,12 +168,12 @@ let run_command request = let corpus = Global.corpus_get corpus_index in let count = Array.fold_left - (fun acc (id,graph) -> - let matching_list = Graph.search_pattern ~config pattern graph in - (List.length matching_list) + acc - ) 0 corpus in - Yojson.Basic.to_string - (`Assoc [("status", `String "OK"); ("data", `Int count)]) + (fun acc (id,graph) -> + let matching_list = Graph.search_pattern ~config pattern graph in + (List.length matching_list) + acc + ) 0 corpus in + Yojson.Basic.to_string + (`Assoc [("status", `String "OK"); ("data", `Int count)]) with | Error msg -> json_error msg end @@ -191,7 +190,7 @@ let run_command request = let pattern = Pattern.parse ~config string_pattern in let matching_list = Graph.search_pattern ~config pattern gr in let json_list = List.map (fun m -> Matching.to_json pattern gr m) matching_list in - Yojson.Basic.to_string (`Assoc [("status", `String "OK"); ("data", `List (json_list))]) + Yojson.Basic.to_string (`Assoc [("status", `String "OK"); ("data", `List (json_list))]) | _ -> json_error "incomplete 'search' command" end @@ -202,13 +201,13 @@ let run_command request = json |> member "graph" |> to_string_option, json |> member "grs_index" |> to_int_option, json |> member "strat" |> to_string_option - ) with + ) with | Some graph, Some grs_index, Some strat -> let gr = Graph.of_json_python ~config (Yojson.Basic.from_string graph) in let grs = Global.grs_get grs_index in let graph_list = Rewrite.simple_rewrite ~config gr grs strat in - Yojson.Basic.to_string - (`Assoc [ + Yojson.Basic.to_string + (`Assoc [ ("status", `String "OK"); ("data", `List (List.map (Graph.to_json_python ~config) graph_list)) ]) @@ -221,8 +220,8 @@ let run_command request = match json |> member "grs_index" |> to_int_option with | Some grs_index -> let grs = Global.grs_get grs_index in - Yojson.Basic.to_string - (`Assoc [ + Yojson.Basic.to_string + (`Assoc [ ("status", `String "OK"); ("data", Grs.to_json_python ~config grs) ]) @@ -237,8 +236,8 @@ let run_command request = let gr = Graph.of_json_python ~config (Yojson.Basic.from_string graph) in let dot = Graph.to_dot ~config gr in let png_file = Utils.dot_to_png dot in - Yojson.Basic.to_string - (`Assoc [ + Yojson.Basic.to_string + (`Assoc [ ("status", `String "OK"); ("data", `String png_file) ]) @@ -253,8 +252,8 @@ let run_command request = let gr = Graph.of_json_python ~config (Yojson.Basic.from_string graph) in let dep = Graph.to_dep ~config gr in let png_file = Utils.dep_to_png dep in - Yojson.Basic.to_string - (`Assoc [ + Yojson.Basic.to_string + (`Assoc [ ("status", `String "OK"); ("data", `String png_file) ]) @@ -268,11 +267,11 @@ let run_command request = | Some graph -> let gr = Graph.of_json_python ~config (Yojson.Basic.from_string graph) in let svg_file = Utils.dep_to_svg (Graph.to_dep ~config gr) in - Yojson.Basic.to_string - (`Assoc [ - ("status", `String "OK"); - ("data", `String svg_file) - ]) + Yojson.Basic.to_string + (`Assoc [ + ("status", `String "OK"); + ("data", `String svg_file) + ]) | _ -> json_error "incomplete 'graph_svg' command" end @@ -284,42 +283,42 @@ let run_command request = (* ==================================================================================================== *) (* Main *) (* ==================================================================================================== *) - let _ = - let _ = Args.parse () in +let _ = + let _ = Args.parse () in - (* if the caller is known, check if it's alive *) - let _ = match !Global.caller_pid with + (* if the caller is known, check if it's alive *) + let _ = match !Global.caller_pid with | None -> () | Some pid -> - let stop_if_caller_is_dead () = + let stop_if_caller_is_dead () = if not (Process.ok (sprintf "kill -0 %s 2> /dev/null" pid)) then (Debug.log "\ncaller (pid:%s) was stopped, I stop. Bye" pid; exit 0) in - (* check periodically if the caller is still alive *) - Periodic.start 10 stop_if_caller_is_dead in - - let socket = - try Sock.start !Global.port with - | Unix.Unix_error (Unix.EADDRINUSE,_,_) -> - (* normal terminaison for automatic search of available port *) - printf "[Grewpy] Port %d already used, failed to open socket\n" !Global.port; exit 0 - | Unix.Unix_error (error,_,_) -> - printf "[Grewpy] Unix error: %s\n" (Unix.error_message error); exit 1 - | exc -> - printf "[Grewpy] Unexpected error: %s\n" (Printexc.to_string exc); exit 1 - in - - let m = Mutex.create () in - - while true do - let _ = Debug.log "ready to receive data" in - let (local_socket, _) = Unix.accept socket in - let _ = Debug.log "connection accepted, reading request" in - let request = Sock.recv local_socket in - let _ = Debug.log "request received" in - Mutex.lock m; - Debug.log "start to handle request ==>%s<==" (Bytes.to_string request); - let reply = run_command (Bytes.to_string request) in - let _ = Debug.log "sending reply ==>%s<==" reply in - Sock.send local_socket reply; - Mutex.unlock m - done + (* check periodically if the caller is still alive *) + Periodic.start 10 stop_if_caller_is_dead in + + let socket = + try Sock.start !Global.port with + | Unix.Unix_error (Unix.EADDRINUSE,_,_) -> + (* normal terminaison for automatic search of available port *) + printf "[Grewpy] Port %d already used, failed to open socket\n" !Global.port; exit 0 + | Unix.Unix_error (error,_,_) -> + printf "[Grewpy] Unix error: %s\n" (Unix.error_message error); exit 1 + | exc -> + printf "[Grewpy] Unexpected error: %s\n" (Printexc.to_string exc); exit 1 + in + + let m = Mutex.create () in + + while true do + let _ = Debug.log "ready to receive data" in + let (local_socket, _) = Unix.accept socket in + let _ = Debug.log "connection accepted, reading request" in + let request = Sock.recv local_socket in + let _ = Debug.log "request received" in + Mutex.lock m; + Debug.log "start to handle request ==>%s<==" (Bytes.to_string request); + let reply = run_command (Bytes.to_string request) in + let _ = Debug.log "sending reply ==>%s<==" reply in + Sock.send local_socket reply; + Mutex.unlock m + done