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

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


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
28

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

let empty_grs = Grs.empty

let grs file doc_output_dir = 
29
30
31
32
33
34
35
36
37
38
  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))
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
    | 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 grs_only file = 
  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
      grs
    with 
    | Grew_parser.Parse_error msg -> raise (Parsing_err msg)
    | Utils.Build (msg,loc) -> raise (Build (msg,loc))
55
56
57
58
59
60
    | 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
61
let get_available_seq grs = Grs.sequences grs
62
63
    
    
pj2m's avatar
pj2m committed
64
65
66
let empty_gr = Instance.empty

let gr file =
67
68
69
70
71
72
73
74
75
76
77
78
79
80
  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)
   )
pj2m's avatar
pj2m committed
81
82
83
84
85
86

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
87
88
  | Utils.Bug (msg, loc) -> raise (Bug (msg,loc))
  | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
89
90
        
        
pj2m's avatar
pj2m committed
91
IFDEF DEP2PICT THEN
pj2m's avatar
pj2m committed
92
93
let rewrite_to_html_intern ?(no_init=false) ?main_feat grs_file grs seq input output nb_sentence previous next = 
  let buff = Buffer.create 16 in
pj2m's avatar
pj2m committed
94

pj2m's avatar
pj2m committed
95
96
97
98
  let head = Printf.sprintf "
      <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 "") 
          (if next <> "" then (Printf.sprintf " -- <a href=\"%s.html\">Sentence %d</a>" next (nb_sentence+1)) else "") in
bguillaum's avatar
bguillaum committed
99
100


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

pj2m's avatar
pj2m committed
106
  try
107
108
109
110
111
112
  	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
113
114
        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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
      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
pj2m's avatar
pj2m committed
130
  with 
131
    | exc -> 
pj2m's avatar
pj2m committed
132
133
134
135
136
137
      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
138
139
  	  
 
pj2m's avatar
pj2m committed
140
141
142
143


let rewrite_to_html ?main_feat input_dir grs output_dir no_init current_grs_file current_grs seq title =
  try
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
    
    (* 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))
pj2m's avatar
pj2m committed
168
            ?main_feat
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
            !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 = "<link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">" in
    
    ignore(Sys.command("cp "^(Filename.concat DATA_DIR "style.css")^" "^(Filename.concat output_dir "style.css")));
    
    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";
    Utils.StringMap.iter 
      (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";
        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<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)
            | h::t -> 
                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;
            if (!counter > 10) 
            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"
                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 "</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\">";
    List.iter 
      (fun err -> 
        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>";

pj2m's avatar
pj2m committed
261
262
263

  
  
264
265
266
267
268
    Printf.fprintf out_ch "</table></center>\n";

    close_out out_ch;
    ()

bguillaum's avatar
bguillaum committed
269
270
271
272
  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))
pj2m's avatar
pj2m committed
273
ENDIF
pj2m's avatar
pj2m committed
274
275
let get_css_file = Filename.concat DATA_DIR "style.css"