libgrew.ml 8.06 KB
Newer Older
pj2m's avatar
pj2m committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 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
include Grew_types

open Log

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

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 -> raise (Bug msg)
		| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc)))
	) 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 -> raise (Bug msg)
		| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc)))

	) 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 -> raise (Bug msg)
  | exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc)))
  
  
let rewrite_to_html ?main_feat input_dir grs output_dir no_init current_grs_file current_grs seq title =
  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 "<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

    let title = "Sentence "^(string_of_int nb_sentence) in

		let buff = Buffer.create 16 in

		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

		let title = "Sentence "^(string_of_int nb_sentence) in

		Printf.bprintf buff "%s\n" head;
		Printf.bprintf buff "<b>GRS file</b>: <a href=\"file:///%s\">%s</a></h2><br/>\n" (Filename.concat (Filename.dirname output) (Filename.basename grs_file)) (Filename.basename grs_file);
		Printf.bprintf buff "<b>Input file</b>: <a href=\"file:///%s\">%s</a></h2>\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 = 
		let ast_gr = 
			Grew_parser.parse_file_to_gr input in	
		 	(* Checker.check_gr ast_gr; *)
			Instance.build ast_gr 
		in
		let rew_hist = Grs.rewrite grs seq init in
		(* let _ = Grs.build_rew_display grs seq init in *)
		let stats = if (no_init) then (
			Rewrite_history.save_html ~mode:Rewrite_history.Only_nfs ~header:(Buffer.contents buff) ~title output rew_hist
		) else (
			Rewrite_history.save_html ~mode:Rewrite_history.Normal ~header:(Buffer.contents buff) ~title output rew_hist
		) in
		stats
	in
	
  (* get ALL gr files *)
  let gr_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") gr_files)) 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
  
  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<(List.length gr_files) then (Filename.chop_extension (List.nth gr_files (!sentence_counter)))  else "") 
    in
    incr sentence_counter;
    List.iter (fun rules ->
      let ruls = try ref (Utils.StringMap.find (fst rules) !stats) with Not_found -> ref Utils.StringMap.empty in
      List.iter (fun r ->
	let old = try Utils.StringMap.find r !ruls with Not_found -> [] in
	ruls := Utils.StringMap.add r (input::old) !ruls
		) (snd rules);
      stats := Utils.StringMap.add (fst rules) !ruls !stats
	      ) rules;
	    ) 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" (List.length gr_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 (float_of_int !counter/.(float_of_int (List.length gr_files))*.100.);
			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;
	Printf.fprintf out_ch "</table></center>\n";
	
	close_out out_ch;
	()
  
  
  
  
let get_css_file = Filename.concat DATA_DIR "style.css"