libgrew.ml 11.2 KB
Newer Older
pj2m's avatar
pj2m committed
1 2
include Grew_types

bguillaum's avatar
bguillaum committed
3
open Printf
pj2m's avatar
pj2m committed
4 5
open Log

6
open Utils
pj2m's avatar
pj2m committed
7 8 9 10 11 12 13 14
open Grew_parser
open Checker
open Grs
open Graph
open Rule
open HTMLer


bguillaum's avatar
bguillaum committed
15

pj2m's avatar
pj2m committed
16 17 18 19 20
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
bguillaum's avatar
bguillaum committed
21
exception Bug of string * (string * int) option
pj2m's avatar
pj2m committed
22 23 24 25 26 27

type grs = Grs.t
type gr = Instance.t

let empty_grs = Grs.empty

bguillaum's avatar
bguillaum committed
28 29 30 31
let load_grs ?doc_output_dir file =
  if not (Sys.file_exists file)
  then raise (File_dont_exists file)
  else
32 33 34
    try
      let ast = Grew_parser.parse_file_to_grs file in
      (* Checker.check_grs ast; *)
bguillaum's avatar
bguillaum committed
35 36 37 38 39
      (match doc_output_dir with
      | None -> ()
      | Some dir -> HTMLer.proceed dir ast);
      Grs.build ast
    with
40 41
    | Grew_parser.Parse_error msg -> raise (Parsing_err msg)
    | Utils.Build (msg,loc) -> raise (Build (msg,loc))
42 43
    | Utils.Bug (msg, loc) -> raise (Bug (msg,loc))
    | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
bguillaum's avatar
bguillaum committed
44 45


pj2m's avatar
pj2m committed
46
let get_available_seq grs = Grs.sequences grs
bguillaum's avatar
bguillaum committed
47

pj2m's avatar
pj2m committed
48 49
let empty_gr = Instance.empty

bguillaum's avatar
bguillaum committed
50
let load_gr file =
51 52 53
  if (Sys.file_exists file) then (
    try
      let ast = Grew_parser.parse_file_to_gr file in
bguillaum's avatar
bguillaum committed
54
      (* Checker.check_gr ast;*)
55 56 57 58 59 60 61 62 63 64
      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)
   )
pj2m's avatar
pj2m committed
65 66 67 68 69 70

let rewrite ~gr ~grs ~seq =
  try
    Grs.build_rew_display grs seq gr
  with
  | Utils.Run (msg,loc) -> raise (Run (msg,loc))
bguillaum's avatar
bguillaum committed
71 72
  | Utils.Bug (msg, loc) -> raise (Bug (msg,loc))
  | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
bguillaum's avatar
bguillaum committed
73

bguillaum's avatar
bguillaum committed
74
let rules_stat grs_file grs seq input =
bguillaum's avatar
bguillaum committed
75 76 77
  try
    let init = Instance.build (Grew_parser.parse_file_to_gr input) in
    let rew_hist = Grs.rewrite grs seq init in
bguillaum's avatar
bguillaum committed
78 79 80 81 82 83
    StringMap.fold
      (fun key value acc ->
        (key,value)::acc
      ) 
      (Rewrite_history.rules_stat rew_hist) 
      []
bguillaum's avatar
bguillaum committed
84 85 86 87 88
  with
  | Utils.Run (msg, Some (loc_file,loc_line)) ->
      Log.fmessage "[file: %s, line: %d] Utils.run: %s\n" loc_file loc_line msg; []
  | exc ->
      Log.fmessage "Unexpected exception: %s\n" (Printexc.to_string exc); []
bguillaum's avatar
bguillaum committed
89
        
bguillaum's avatar
bguillaum committed
90 91
        IFDEF DEP2PICT THEN
let rewrite_to_html_intern ?(no_init=false) ?main_feat grs_file grs seq input output nb_sentence previous next =
pj2m's avatar
pj2m committed
92
  let buff = Buffer.create 16 in
pj2m's avatar
pj2m committed
93

pj2m's avatar
pj2m committed
94
  let head = Printf.sprintf "
bguillaum's avatar
bguillaum committed
95 96
      <div class=\"navbar\">%s<a href=\"index.html\">Up</a>%s</div><br/>"
          (if previous <> "" then (Printf.sprintf "<a href=\"%s.html\">Sentence %d</a> -- " previous (nb_sentence-1)) else "")
pj2m's avatar
pj2m committed
97
          (if next <> "" then (Printf.sprintf " -- <a href=\"%s.html\">Sentence %d</a>" next (nb_sentence+1)) else "") in
bguillaum's avatar
bguillaum committed
98 99


pj2m's avatar
pj2m committed
100
  Printf.bprintf buff "%s\n" head;
101
  Printf.bprintf buff "<b>GRS file</b>: <a href=\"file://%s\">%s</a></h2><br/>\n" (Filename.basename grs_file) (Filename.basename grs_file);
102
  Printf.bprintf buff "<b>Input file</b>: <a href=\"%s\">%s</a></h2>\n" (Filename.basename input) (Filename.basename input);
pj2m's avatar
pj2m committed
103
  ignore(Sys.command(Printf.sprintf "cp %s %s" input (Filename.concat (Filename.dirname output) (Filename.basename input))));
104

pj2m's avatar
pj2m committed
105
  try
bguillaum's avatar
bguillaum committed
106 107
    let init = Instance.build (Grew_parser.parse_file_to_gr input) in
    try
108 109
      let rew_hist = Grs.rewrite grs seq init in
      (* let _ = Grs.build_rew_display grs seq init in *)
bguillaum's avatar
bguillaum committed
110
      let stats =
111
        if no_init
112 113
        then Some (Rewrite_history.save_html ?main_feat ~init_graph:false ~header:(Buffer.contents buff) output nb_sentence rew_hist)
        else Some (Rewrite_history.save_html ?main_feat ~header:(Buffer.contents buff) output nb_sentence rew_hist) in
bguillaum's avatar
bguillaum committed
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
      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 "<h6>Initial graph</h6>\n";
        Instance.save_dep_png ?main_feat output init;
        fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" (Filename.basename output);
        fprintf html_ch "<h2>ERROR during rewriting:</h2>\n";
        fprintf html_ch "<p>Message: %s</p>\n" msg;
        fprintf html_ch "<p>File: %s</p>\n" loc_file;
        fprintf html_ch "<p>Line: %d</p>\n" loc_line;
        Html.leave html_ch;
        close_out html_ch;
        None
  with
  | exc ->
pj2m's avatar
pj2m committed
131 132 133 134 135 136 137 138 139 140
      let html_ch = open_out (sprintf "%s.html" output) in
      let () = Html.enter html_ch ~header:(Buffer.contents buff) output in
      fprintf html_ch "<h1>UNEXPECTED EXCEPTION: %s</h1>" (Printexc.to_string exc);
      Html.leave html_ch;
      close_out html_ch;
      None


let rewrite_to_html ?main_feat input_dir grs output_dir no_init current_grs_file current_grs seq title =
  try
bguillaum's avatar
bguillaum committed
141

142 143 144 145 146 147
    (* 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

bguillaum's avatar
bguillaum committed
148
    (* create html files *)
149 150
    ignore(Sys.command(Printf.sprintf "cp %s %s" grs (Filename.concat output_dir (Filename.basename grs))));
    let sentence_counter = ref 1 in
bguillaum's avatar
bguillaum committed
151

bguillaum's avatar
bguillaum committed
152
    let stats = ref StringMap.empty in
153 154
    let errors = ref [] in

bguillaum's avatar
bguillaum committed
155 156
    List.iter
      (fun input ->
157 158 159 160 161 162 163 164
        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))
pj2m's avatar
pj2m committed
165
            ?main_feat
166 167
            !sentence_counter
            (if !sentence_counter > 1 then (Filename.chop_extension (List.nth gr_files (!sentence_counter-2))) else "")
bguillaum's avatar
bguillaum committed
168
            (if !sentence_counter < nb_files then (Filename.chop_extension (List.nth gr_files (!sentence_counter)))  else "")
169 170 171
        in
        incr sentence_counter;
        match rules with
bguillaum's avatar
bguillaum committed
172 173 174 175
        | Some module_list ->
            List.iter
              (fun (module_name, rule_list) ->
                let old_rule_list =
bguillaum's avatar
bguillaum committed
176 177
                  try ref (StringMap.find module_name !stats)
                  with Not_found -> ref StringMap.empty in
bguillaum's avatar
bguillaum committed
178
                List.iter
179
                  (fun rule ->
bguillaum's avatar
bguillaum committed
180 181
                    let old = try StringMap.find rule !old_rule_list with Not_found -> [] in
                    old_rule_list := StringMap.add rule (input::old) !old_rule_list
182
                  ) rule_list;
bguillaum's avatar
bguillaum committed
183
                stats := StringMap.add module_name !old_rule_list !stats
184 185 186 187 188
              ) module_list
        | None -> errors := input :: !errors
      ) gr_files;


bguillaum's avatar
bguillaum committed
189

190
    let out_ch = open_out (Filename.concat output_dir "index.html") in
bguillaum's avatar
bguillaum committed
191

192
    let css = "<link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">" in
bguillaum's avatar
bguillaum committed
193

194
    ignore(Sys.command("cp "^(Filename.concat DATA_DIR "style.css")^" "^(Filename.concat output_dir "style.css")));
bguillaum's avatar
bguillaum committed
195

196 197 198 199 200
    Printf.fprintf out_ch "<head>\n%s\n<title>%s</title>\n<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" /></head>\n" css title;
    Printf.fprintf out_ch "<h1>%s</h1>\n" title;
    Printf.fprintf out_ch "<b>Grs file</b>:%s\n<br/>\n" (Filename.basename current_grs_file);
    Printf.fprintf out_ch "<b>%d Sentences</b><br/>\n<br/>\n" nb_files;
    Printf.fprintf out_ch "<center><table cellpadding=10 cellspacing=0 width=90%%>\n";
bguillaum's avatar
bguillaum committed
201
    StringMap.iter
202 203 204
      (fun modul rules ->
        Printf.fprintf out_ch "<tr><td colspan=5><h6>Module %s</h6></td>\n" modul;
        Printf.fprintf out_ch "<tr><th class=\"first\" width=10>Rule</th><th width=10>#occ</th><th width=10>#files</th><th width=10>Ratio</th><th width=10>Files</th></tr>\n";
bguillaum's avatar
bguillaum committed
205
        StringMap.iter
206 207 208 209 210 211 212 213 214 215 216
          (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<div id=\"%s_%s\" style=\"display:none;\">\n" !tmp modul rule
                 );
                incr counter;
                tmp := Printf.sprintf "%s<a href=\"%s\">%s</a>" !tmp ((Filename.chop_extension h)^".html") (Filename.chop_extension h)
bguillaum's avatar
bguillaum committed
217
            | h::t ->
218 219 220 221 222 223 224 225 226 227 228
                if (not (List.mem h t)) then ( (*avoid doublons*)
                  if (!counter = 10) then (
                    tmp := Printf.sprintf "%s<div id=\"%s_%s\" style=\"display:none;\">\n" !tmp modul rule
                   );
                  incr counter;
                  tmp := Printf.sprintf "%s<a href=\"%s\">%s</a><br/>" !tmp ((Filename.chop_extension h)^".html") (Filename.chop_extension h)
                 );
                compute t
            in compute (List.rev files);
            Printf.fprintf out_ch "<tr><td class=\"first_stats\" width=10 valign=top>%s</td><td class=\"stats\" width=10 valign=top>%d</td><td class=\"stats\" width=10 valign=top>%d</td><td class=\"stats\" width=10 valign=top>%.2f%%</td>" rule (List.length files) !counter (ratio !counter);
            Printf.fprintf out_ch "<td class=\"stats\">%s" !tmp;
bguillaum's avatar
bguillaum committed
229
            if (!counter > 10)
230 231
            then (
              Printf.fprintf out_ch "</div><a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s_%s').style.display == 'none') { %s } else { %s }\"><b><p id=\"p_%s_%s\">+ Show more +</p></b></a>\n"
bguillaum's avatar
bguillaum committed
232
                modul rule
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
                (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 "</td></tr>\n";
          ) rules;
      ) !stats;

    (* add a subtalbe for sentence that produces an error *)
    let nb_errors = List.length !errors in
    Printf.fprintf out_ch "<tr><td colspan=5><h6>ERRORS</h6></td>\n";
    Printf.fprintf out_ch "<tr><th class=\"first\" width=10>Rule</th><th colspan=2 width=20>#files</th><th width=10>Ratio</th><th>Files</th></tr>\n";

    Printf.fprintf out_ch "<tr>\n";
    Printf.fprintf out_ch "<td class=\"first_stats\">Errors</td>\n";
    Printf.fprintf out_ch "<td class=\"stats\" colspan=2>%d</td>\n" nb_errors;
    Printf.fprintf out_ch "<td class=\"stats\">%.2f%%</td>\n" (ratio nb_errors);
    Printf.fprintf out_ch "<td class=\"stats\">";
bguillaum's avatar
bguillaum committed
251 252
    List.iter
      (fun err ->
253 254 255 256 257 258 259 260 261 262
        Printf.fprintf out_ch "<a href=\"%s.html\">%s</a><br/>" (Filename.chop_extension err) (Filename.chop_extension err)
      ) (List.rev !errors);
    Printf.fprintf out_ch "</td>\n";
    Printf.fprintf out_ch "</tr>";

    Printf.fprintf out_ch "</table></center>\n";

    close_out out_ch;
    ()

bguillaum's avatar
bguillaum committed
263 264 265 266
  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))
bguillaum's avatar
bguillaum committed
267
        ENDIF
pj2m's avatar
pj2m committed
268 269
let get_css_file = Filename.concat DATA_DIR "style.css"