include Grew_types open Printf open Log open Utils open Grew_parser open Checker open Grs open Graph open Rule open HTMLer exception Parsing_err of string exception File_dont_exists of string exception Build of string * (string * int) option exception Run of string * (string * int) option exception Bug of string * (string * int) option type grs = Grs.t type gr = Instance.t let empty_grs = Grs.empty let grs file doc_output_dir = if (Sys.file_exists file) then ( try let ast = Grew_parser.parse_file_to_grs file in (* Checker.check_grs ast; *) let grs = Grs.build ast in HTMLer.proceed doc_output_dir ast; grs with | Grew_parser.Parse_error msg -> raise (Parsing_err msg) | Utils.Build (msg,loc) -> raise (Build (msg,loc)) | Utils.Bug (msg, loc) -> raise (Bug (msg,loc)) | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) ) else ( raise (File_dont_exists file) ) let get_available_seq grs = Grs.sequences grs let empty_gr = Instance.empty let gr file = if (Sys.file_exists file) then ( try let ast = Grew_parser.parse_file_to_gr file in (* Checker.check_gr ast;*) Instance.build ast with | Grew_parser.Parse_error msg -> raise (Parsing_err msg) | Utils.Build (msg,loc) -> raise (Build (msg,loc)) | Utils.Bug (msg, loc) -> raise (Bug (msg,loc)) | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) ) else ( raise (File_dont_exists file) ) let rewrite ~gr ~grs ~seq = try Grs.build_rew_display grs seq gr with | Utils.Run (msg,loc) -> raise (Run (msg,loc)) | Utils.Bug (msg, loc) -> raise (Bug (msg,loc)) | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) let rewrite_to_html ?main_feat input_dir grs output_dir no_init current_grs_file current_grs seq title = try let rewrite_to_html_intern ?(no_init=false) grs_file grs seq input output nb_sentence previous next = let buff = Buffer.create 16 in let head = Printf.sprintf "
%sUp%s

" (if previous <> "" then (Printf.sprintf "Sentence %d -- " previous (nb_sentence-1)) else "") (if next <> "" then (Printf.sprintf " -- Sentence %d" next (nb_sentence+1)) else "") in let title = "Sentence "^(string_of_int nb_sentence) in Printf.bprintf buff "%s\n" head; Printf.bprintf buff "GRS file: %s
\n" (Filename.concat (Filename.dirname output) (Filename.basename grs_file)) (Filename.basename grs_file); Printf.bprintf buff "Input file: %s\n" (Filename.concat (Filename.dirname output) (Filename.basename input)) (Filename.basename input); ignore(Sys.command(Printf.sprintf "cp %s %s" input (Filename.concat (Filename.dirname output) (Filename.basename input)))); let init = Instance.build (Grew_parser.parse_file_to_gr input) in try let rew_hist = Grs.rewrite grs seq init in (* let _ = Grs.build_rew_display grs seq init in *) let stats = if no_init then Some (Rewrite_history.save_html ?main_feat ~init_graph:false ~header:(Buffer.contents buff) output rew_hist) else Some (Rewrite_history.save_html ?main_feat ~header:(Buffer.contents buff) output rew_hist) in stats with | Utils.Run (msg, Some (loc_file,loc_line)) -> let html_ch = open_out (sprintf "%s.html" output) in let () = Html.enter html_ch ~header:(Buffer.contents buff) output in fprintf html_ch "
Initial graph
\n"; Instance.save_dep_png ?main_feat output init; fprintf html_ch "
\n" (Filename.basename output); fprintf html_ch "

ERROR during rewriting:

\n"; fprintf html_ch "

Message: %s

\n" msg; fprintf html_ch "

File: %s

\n" loc_file; fprintf html_ch "

Line: %d

\n" loc_line; Html.leave html_ch; close_out html_ch; None | exc -> let html_ch = open_out (sprintf "%s.html" output) in let () = Html.enter html_ch ~header:(Buffer.contents buff) output in fprintf html_ch "

UNEXPECTED EXCEPTION: %s

" (Printexc.to_string exc); Html.leave html_ch; close_out html_ch; None in (* get ALL gr files *) let all_files = Array.to_list (Sys.readdir input_dir) in let gr_files = List.sort (fun a b -> compare a b) (List.filter (fun file -> Filename.check_suffix file ".gr") all_files) in let nb_files = List.length gr_files in let ratio nb = (float nb) /. (float nb_files) *. 100. in (* create html files *) ignore(Sys.command(Printf.sprintf "cp %s %s" grs (Filename.concat output_dir (Filename.basename grs)))); let sentence_counter = ref 1 in let stats = ref Utils.StringMap.empty in let errors = ref [] in List.iter (fun input -> Log.fmessage "Computing %s" input; let rules = rewrite_to_html_intern ~no_init current_grs_file current_grs seq (Filename.concat input_dir input) (Filename.concat output_dir (Filename.chop_extension input)) !sentence_counter (if !sentence_counter > 1 then (Filename.chop_extension (List.nth gr_files (!sentence_counter-2))) else "") (if !sentence_counter < nb_files then (Filename.chop_extension (List.nth gr_files (!sentence_counter))) else "") in incr sentence_counter; match rules with | Some module_list -> List.iter (fun (module_name, rule_list) -> let old_rule_list = try ref (Utils.StringMap.find module_name !stats) with Not_found -> ref Utils.StringMap.empty in List.iter (fun rule -> let old = try Utils.StringMap.find rule !old_rule_list with Not_found -> [] in old_rule_list := Utils.StringMap.add rule (input::old) !old_rule_list ) rule_list; stats := Utils.StringMap.add module_name !old_rule_list !stats ) module_list | None -> errors := input :: !errors ) gr_files; let out_ch = open_out (Filename.concat output_dir "index.html") in let css = "" in ignore(Sys.command("cp "^(Filename.concat DATA_DIR "style.css")^" "^(Filename.concat output_dir "style.css"))); Printf.fprintf out_ch "\n%s\n%s\n\n" css title; Printf.fprintf out_ch "

%s

\n" title; Printf.fprintf out_ch "Grs file:%s\n
\n" (Filename.basename current_grs_file); Printf.fprintf out_ch "%d Sentences
\n
\n" nb_files; Printf.fprintf out_ch "
\n"; Utils.StringMap.iter (fun modul rules -> Printf.fprintf out_ch "\n" modul; Printf.fprintf out_ch "\n"; Utils.StringMap.iter (fun rule files -> let tmp = ref "" in let counter = ref 0 in let rec compute list = match list with | [] -> () | h::[] -> if (!counter = 10) then ( tmp := Printf.sprintf "%s
\n" !tmp modul rule ); incr counter; tmp := Printf.sprintf "%s%s" !tmp ((Filename.chop_extension h)^".html") (Filename.chop_extension h) | h::t -> if (not (List.mem h t)) then ( (*avoid doublons*) if (!counter = 10) then ( tmp := Printf.sprintf "%s
\n" !tmp modul rule ); incr counter; tmp := Printf.sprintf "%s%s
" !tmp ((Filename.chop_extension h)^".html") (Filename.chop_extension h) ); compute t in compute (List.rev files); Printf.fprintf out_ch "
" rule (List.length files) !counter (ratio !counter); Printf.fprintf out_ch "\n"; ) rules; ) !stats; (* add a subtalbe for sentence that produces an error *) let nb_errors = List.length !errors in Printf.fprintf out_ch "\n"; Printf.fprintf out_ch "\n"; Printf.fprintf out_ch "\n"; Printf.fprintf out_ch "\n"; Printf.fprintf out_ch "\n" nb_errors; Printf.fprintf out_ch "\n" (ratio nb_errors); Printf.fprintf out_ch "\n"; Printf.fprintf out_ch ""; Printf.fprintf out_ch "
Module %s
Rule#occ#filesRatioFiles
%s%d%d%.2f%%%s" !tmp; if (!counter > 10) then ( Printf.fprintf out_ch "

+ Show more +

\n" modul rule (Printf.sprintf "document.getElementById('%s_%s').style.display = 'block'; document.getElementById('p_%s_%s').innerHTML = '- Show less -';" modul rule modul rule) (Printf.sprintf "document.getElementById('%s_%s').style.display = 'none';; document.getElementById('p_%s_%s').innerHTML = '+ Show more +';" modul rule modul rule) modul rule; ); Printf.fprintf out_ch "
ERRORS
Rule#filesRatioFiles
Errors%d%.2f%%"; List.iter (fun err -> Printf.fprintf out_ch "%s
" (Filename.chop_extension err) (Filename.chop_extension err) ) (List.rev !errors); Printf.fprintf out_ch "
\n"; close_out out_ch; () with | Utils.Run (msg,loc) -> raise (Run (msg,loc)) | Utils.Bug (msg, loc) -> raise (Bug (msg,loc)) | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) let get_css_file = Filename.concat DATA_DIR "style.css"