Commit edd3d24d authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files

JSON errors

parent a6abecdc
......@@ -24,7 +24,7 @@ module Grew_args = struct
let output = ref Conll
let (input_data : string list ref) = ref []
let (output_file : string option ref) = ref None
let (output_data : string option ref) = ref None
let strat = ref "main"
let quiet = ref false
let timeout = ref None
......@@ -105,7 +105,7 @@ module Grew_args = struct
| "-grs" :: file :: args -> grs := Some file; loop args
| "-i" :: files :: args ->
input_data := (Str.split (Str.regexp " ") files) @ !input_data; loop args
| "-o" :: file :: args -> output_file := Some file; loop args
| "-o" :: file :: args -> output_data := Some file; loop args
| "-strat" :: s :: args -> strat := s; loop args
| "-pattern" :: files :: args -> patterns := (Str.split (Str.regexp " ") files); loop args
| "-patterns" :: files :: args ->
......
......@@ -19,22 +19,18 @@ open Grew_args
(* -------------------------------------------------------------------------------- *)
let fail msg =
Log.fmessage "-------------------------------------";
Log.fmessage "%s" msg;
Log.fmessage "-------------------------------------";
exit 2
let fail msg = Log.fmessage "%s" msg; exit 2
let handle fct () =
try fct ()
with
| Error json -> fail (Yojson.Basic.pretty_to_string json)
| Conll_error json -> fail (Yojson.Basic.pretty_to_string json)
| Libgrew.Error msg -> fail msg
| Corpus_.File_not_found file -> fail (sprintf "File not found: \"%s\"" file)
| Corpus_.Fail msg -> fail msg
| Sys_error msg -> fail (sprintf "System error: %s" msg)
| Yojson.Json_error msg -> fail (sprintf "Json error: %s" msg)
| Validation.Error msg -> fail (sprintf "Validation error: %s" msg)
| Libgrew.Bug msg -> fail (sprintf "Libgrew.bug, please report: %s" msg)
| exc -> fail (sprintf "Uncaught exception, please report: %s" (Printexc.to_string exc))
......@@ -50,7 +46,7 @@ let transform () =
let graph_array = Corpus_.input ?domain () in
let len = Array.length graph_array in
let out_ch = match !Grew_args.output_file with
let out_ch = match !Grew_args.output_data with
| Some output_file -> open_out output_file
| None -> stdout in
......@@ -77,7 +73,7 @@ let transform () =
) l
) graph_array;
Counter.finish ();
match !Grew_args.output_file with
match !Grew_args.output_data with
| Some output_file -> close_out out_ch
| None -> ()
) ()
......@@ -188,51 +184,63 @@ let clean () =
(* -------------------------------------------------------------------------------- *)
let count () =
match !Grew_args.patterns with
| [] -> Log.fwarning "No pattern given (use option -patterns)"
| l ->
printf "Corpus\t# sentences";
List.iter (fun p -> printf "\t%s" (p |> Filename.basename |> Filename.chop_extension)) l;
printf "\n";
let patterns = List.map Pattern.load l in
List.iter (
fun conf_file ->
let conf = Corpus_desc.load_json conf_file in
List.iter
(fun corpus_desc ->
let id = Corpus_desc.get_id corpus_desc in
let directory = Corpus_desc.get_directory corpus_desc in
let marshal_file = (Filename.concat directory id) ^ ".marshal" in
let in_ch = open_in_bin marshal_file in
let data = (Marshal.from_channel in_ch : Corpus.t) in
let _ = close_in in_ch in
printf "%s\t" (Filename.basename directory);
printf "%d\t" (Corpus.size data);
handle
(fun () ->
match !Grew_args.patterns with
| [] -> Log.fwarning "No pattern given (use option -patterns)"
| l ->
printf "Corpus\t# sentences";
List.iter (fun p -> printf "\t%s" (p |> Filename.basename |> Filename.chop_extension)) l;
printf "\n";
let patterns = List.map Pattern.load l in
List.iter (
fun conf_file ->
let conf = Corpus_desc.load_json conf_file in
List.iter
(fun pattern ->
let count =
Corpus.fold_left (fun acc graph ->
acc + (List.length (Graph.search_pattern pattern graph))
) 0 data in
printf "%d\t" count
) patterns;
printf "\n%!"
) conf
) (!Grew_args.input_data)
(fun corpus_desc ->
let id = Corpus_desc.get_id corpus_desc in
let directory = Corpus_desc.get_directory corpus_desc in
let marshal_file = (Filename.concat directory id) ^ ".marshal" in
let in_ch = open_in_bin marshal_file in
let data = (Marshal.from_channel in_ch : Corpus.t) in
let _ = close_in in_ch in
printf "%s\t" (Filename.basename directory);
printf "%d\t" (Corpus.size data);
List.iter
(fun pattern ->
let count =
Corpus.fold_left (fun acc graph ->
acc + (List.length (Graph.search_pattern pattern graph))
) 0 data in
printf "%d\t" count
) patterns;
printf "\n%!"
) conf
) (!Grew_args.input_data)
) ()
(* -------------------------------------------------------------------------------- *)
let valid () =
let validator_list = List.map Validation.load_json !Grew_args.patterns in
List.iter
(fun conf_file ->
List.iter
(fun corpus_desc ->
Validation.check validator_list corpus_desc
) (Corpus_desc.load_json conf_file)
) !Grew_args.input_data
handle
(fun () ->
match !Grew_args.output_data with
| None -> error ~fct:"valid" "and output directory is required (use -i option)"
| Some dir ->
match ensure_dir dir with
| Some pble -> error ~fct:"valid" "%s" pble
| None ->
let validator_list = List.map Validation.load_json !Grew_args.patterns in
List.iter
(fun conf_file ->
List.iter
(fun corpus_desc ->
Validation.check ~dir validator_list corpus_desc
) (Corpus_desc.load_json conf_file)
) !Grew_args.input_data
) ()
(* -------------------------------------------------------------------------------- *)
......
......@@ -15,6 +15,35 @@ open Libgrew
open Grew_args
exception Error of Yojson.Basic.t
let error_ ?file ?line ?fct ?data msg =
let opt_list = [
Some ("error", `String msg);
(CCOpt.map (fun x -> ("file", `String x)) file);
(CCOpt.map (fun x -> ("line", `Int x)) line);
(CCOpt.map (fun x -> ("function", `String x)) fct);
(CCOpt.map (fun x -> ("data", x)) data);
] in
let json = `Assoc (CCList.filter_map (fun x->x) opt_list) in
raise (Error json)
let error ?file ?line ?fct ?data = Printf.ksprintf (error_ ?file ?line ?fct ?data)
(* ---------------------------------------------------------------------------------------------------- *)
let ensure_dir dir =
try (* catch if dir does not exist *)
match Unix.stat dir with
| { Unix.st_kind = Unix.S_DIR } -> None
| _ -> Some (sprintf "grew_match option ignored: %s already exists and is not directory" dir)
with Unix.Unix_error (Unix.ENOENT,_,_) ->
begin (* dir does not exist -> try to create it *)
try Unix.mkdir dir 0o755; None
with exc -> Some (sprintf "grew_match option ignored: cannot create dir %s (%s)" dir (Printexc.to_string exc))
end
(* ================================================================================ *)
module StringMap = Map.Make (String)
......@@ -263,8 +292,6 @@ end
(* ==================================================================================================== *)
module Validation = struct
exception Error of string
type item = {
pattern: string list;
description: string;
......@@ -275,10 +302,13 @@ module Validation = struct
items: item list
}
(* -------------------------------------------------------------------------------- *)
let load_json json_file =
let open Yojson.Basic.Util in
let json = Yojson.Basic.from_file json_file in
let json =
try Yojson.Basic.from_file json_file
with Yojson.Json_error msg -> error ~fct:"Validation.load_json" ~file:json_file "%s" msg in
let parse_one json =
let pattern =
......@@ -288,7 +318,11 @@ module Validation = struct
|> member "pattern"
|> to_list
|> (List.map to_string)
with Type_error _ -> raise (Error (sprintf "[Validation.load_json, file \"%s\"] \"pattern\" field is mandatory and must be a string or a list of strings" json_file)) in
with Type_error (json_error,_) ->
error
~fct:"Validation.load_json"
~file: json_file
"\"pattern\" field is mandatory and must be a string or a list of strings (%s)" json_error in
let description =
try json |> member "description" |> to_string
with Type_error _ -> "No description" in
......@@ -296,14 +330,18 @@ module Validation = struct
let title =
try json |> member "title" |> to_string
with Type_error _ -> raise (Error (sprintf "[Validation.load_json, file \"%s\"] \"title\"_desc field is mandatory and must be a string" json_file)) in
with Type_error (json_error,_) ->
error
~fct:"Validation.load_json"
~file: json_file
"\"title\" field is mandatory and must be a string or a list of strings (%s)" json_error in
let items = List.map parse_one (json |> member "items" |> to_list) in
{ title; items }
let check modul_list (corpus_desc:Corpus_desc.t) =
(* -------------------------------------------------------------------------------- *)
let check ?dir modul_list (corpus_desc:Corpus_desc.t) =
let corpus = Corpus_desc.build_corpus corpus_desc in
let date =
......@@ -320,7 +358,14 @@ module Validation = struct
`List
(List.map
(fun item ->
let grew_pattern = Pattern.parse (String.concat " " item.pattern) in
let grew_pattern =
try Pattern.parse (String.concat " " item.pattern)
with Libgrew.Error msg ->
error
~fct:"Validation.check"
~data:(`String (String.concat " " item.pattern))
"cannot parse pattern associated with desc: %s" item.description
in
let count =
Corpus.fold_left (fun acc graph ->
acc + (List.length (Graph.search_pattern grew_pattern graph))
......@@ -334,15 +379,16 @@ module Validation = struct
`Assoc ["title", `String modul.title; "items", out_items]
) modul_list) in
let json = `Assoc [
"corpus", `String (Corpus_desc.get_id corpus_desc);
"date", `String date;
"modules", modules
] in
printf "%s\n" (Yojson.Basic.pretty_to_string json)
match dir with
| None -> printf "%s\n" (Yojson.Basic.pretty_to_string json)
| Some dir ->
let out_file = Filename.concat dir ((Corpus_desc.get_id corpus_desc) ^ ".json") in
CCIO.with_out out_file (fun out_ch -> fprintf out_ch "%s\n" (Yojson.Basic.pretty_to_string json))
end
\ No newline at end of file
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