(* export problem-data and method-data to xml

   author: Walther Neuper

   (c) isac-team

use"xmlsrc/pbl-met-hierarchy.sml";

use"pbl-met-hierarchy.sml";

*)

fun str2file (fnm:filename) (str:string) =

    let val file = TextIO.openOut fnm

    in (TextIO.output (file, str);

	TextIO.flushOut file;

	TextIO.closeOut file) end;

fun pos2filename [] = error "pos2filename called with []"

  | pos2filename [i] = "_" ^ string_of_int i ^ ".xml"

  | pos2filename (i::is) = "_" ^ string_of_int i ^ pos2filename is;

(* pos2filename [1,22,3];

val it = "_1_22_3.xml" : string

*)

fun id2filename [] = error "id2filename called with []"

  | id2filename [s] = s ^ ".xml"

  | id2filename (s::ss) = s ^ "_" ^ id2filename ss;

(* id2filename ["linear","univariate","equation"];

val it = "linear_univariate_equation.xml" : string

*)

(*ad DTD: a NODE contains an ID and zero or more NODEs*)

(*old version with pos2filename*)

fun hierarchy pm(*"pbl" | "met"*) h =

    let val j = indentation

	fun nd i p (Ptyp (id,_,ns)) = 

	    let val p' = lev_on p

	    in (indt i) ^ "<NODE>\n" ^ 

	       (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^ 

	       (indt (i+j)) ^ "<NO> " (*on this level*) ^ 

	       (string_of_int o last_elem) p' ^ " </NO>\n" ^ 

	       (indt (i+j)) ^ "<CONTENTREF> " ^ pm ^ pos2filename p' ^ 

	       " </CONTENTREF>\n" ^

	       (nds (i+j) (lev_dn p') ns) ^ 

	       (indt i) ^ "</NODE>\n"

	    end

	and nds _ _ [] = ""

	  | nds i p (n::ns) = (nd i p n) ^ (nds i (lev_on p) ns);

    in nds j [0] h end;

(*.create a hierarchy with references to the guh's.*)

fun hierarchy_pbl h =

    let val j = indentation

	fun nd i p (Ptyp (id,[n as {guh,...} : pbt],ns)) = 

	    let val p' = lev_on p

	    in (indt i) ^ "<NODE>\n" ^ 

	       (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^ 

	       (indt (i+j)) ^ "<NO> " (*on this level*) ^ 

	       (string_of_int o last_elem) p' ^ " </NO>\n" ^ 

	       (indt (i+j)) ^ "<CONTENTREF> " ^ guh ^ 

	       " </CONTENTREF>\n" ^

	       (nds (i+j) (lev_dn p') ns) ^ 

	       (indt i) ^ "</NODE>\n"

	    end

	and nds _ _ [] = "" 

	  | nds i p (n::ns) = (nd i p n) ^ (nds i (lev_on p) ns);

    in nds j [0] h : xml end;

fun hierarchy_met h =

    let val j = indentation

	fun nd i p (Ptyp (id,[n as {guh,...} : met],ns)) = 

	    let val p' = lev_on p

	    in (indt i) ^ "<NODE>\n" ^ 

	       (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^ 

	       (indt (i+j)) ^ "<NO> " (*on this level*) ^ 

	       (string_of_int o last_elem) p' ^ " </NO>\n" ^ 

	       (indt (i+j)) ^ "<CONTENTREF> " ^ guh ^ 

	       " </CONTENTREF>\n" ^

	       (nds (i+j) (lev_dn p') ns) ^ 

	       (indt i) ^ "</NODE>\n"

	    end

	and nds _ _ [] = ""

	  | nds i p (n::ns) = (nd i p n) ^ (nds i (lev_on p) ns);

    in nds j [0] h  : xml end;

(* (writeln o hierarchy_pbl) (!ptyps);

   *)

fun pbl_hierarchy2file (path:path) = 

    str2file (path ^ "pbl_hierarchy.xml") 

	     ("<NODE>\n" ^

	      "  <ID> problem hierarchy </ID>\n" ^

	      "  <NO> 1 </NO>\n" ^

	      "  <CONTENTREF> pbl_ROOT </CONTENTREF>\n" ^

	     (hierarchy_pbl (get_ptyps ())) ^

	     "</NODE>");

fun met_hierarchy2file (path:path) = 

    str2file (path ^ "met_hierarchy.xml") 

	     ("<NODE>\n" ^

	      "  <ID> method hierarchy </ID>\n" ^

	      "  <NO> 1 </NO>\n" ^

	      "  <CONTENTREF> met_ROOT </CONTENTREF>\n" ^

	     (hierarchy_met (get_mets ())) ^

	     "</NODE>");

(**.create the xml-files for the pbls, mets from the hierarchy.**)

val i = indentation;

fun pbl2term thy (pblRD:pblRD) = (*WN120405.TODO.txt*)

  str2term ("Problem (" ^ (get_thy o theory2domID) thy ^ "', " ^ (strs2str' o rev) pblRD ^ ")");

(* term2str (pbl2term (Thy_Info.get_theory "Isac") ["equations","univariate","normalize"]);

val it = "Problem (Isac, [normalize, univariate, equations])" : string

*)

(*.format a problem in xml for presentation on the problem browser;

   new version with <KESTOREREF>s -- not used because linking

   requires elements (rls, calc, ...) to be reorganized.*)

(*######## ATTENTION: THIS IS not THE ACTUAL VERSION ################*)

fun pbl2xml (id:(*pblRD*)pblID) ({guh,mathauthors,init,cas,met,ppc,prls,

			 thy,where_}:pbt) =

    let val thy' = theory2theory' thy

	val prls' = (#id o rep_rls) prls

    in "<NODECONTENT>\n" ^

       indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^

       (((id2xml i)(* o rev*)) id) ^ 

       indt i ^ "<META> </META>\n" ^

       (*--------------- begin display ------------------------------*)

       indt i ^ "<HEADLINE>\n" ^

       (case cas of NONE => term2xml i (pbl2term thy id)

		  | SOME t => term2xml i t) ^ "\n" ^

       indt i ^ "</HEADLINE>\n" ^

       (*--------------- hline --------------------------------------*)

       pattern2xml i ppc where_ ^

       (*--------------- hline --------------------------------------*)

       indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n"

       (*--------------- end display --------------------------------*)

       ^

       indt i ^ "<THEORY>\n" ^ 

       theref2xml (i+i) thy' "Theorems" "" ^

       indt i ^ "</THEORY>\n" ^

       (case met of [] => (indt i) ^ "<METHODS> </METHODS>\n"

		  | _ => (indt i) ^ "<METHODS>\n" ^

			 foldl op^ ("", map (keref2xml (i+i) Met_) met) ^

			 (indt i) ^ "</METHODS>\n") ^

       indt i ^ "<EVALPRECOND>\n" ^ 

       theref2xml (i+i) (snd (thy_containing_rls thy' prls')) "Rulesets" prls'^

       indt i ^ "</EVALPRECOND>\n" ^

       authors2xml i "MATHAUTHORS" mathauthors ^

       authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^

       "</NODECONTENT>" : xml

    end;

(*.format a problem in xml for presentation on the problem browser;

   old version with 'dead' strings for rls, calc, ....*)

(* 

val pblID = ["linear","univariate","equation"];

val pblID = ["degree_4","polynomial","univariate","equation"];

val pblID = rev ["tool","find_values"];

val (id, {guh,mathauthors,init,cas,met,ppc,prls,thy,where_}:pbt) =

       (pblID, get_pbt pblID);

   *)

fun pbl2xml (id:(*pblRD*)pblID) ({guh,mathauthors,init,cas,met,ppc,prls,

			 thy,where_}:pbt) =

    "<NODECONTENT>\n" ^

    indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^

    (((id2xml i)(* o rev*)) id) ^ 

    indt i ^ "<META> </META>\n" ^

    (*--------------- begin display ------------------------------*)

    indt i ^ "<HEADLINE>\n" ^

    (case cas of NONE => term2xml i (pbl2term thy id)

	       | SOME t => term2xml i t) ^ "\n" ^

    indt i ^ "</HEADLINE>\n" ^

    (*--------------- hline --------------------------------------*)

    pattern2xml i ppc where_ ^

    (*--------------- hline --------------------------------------*)

    indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n"

    (*--------------- end display --------------------------------*)

    ^

    indt i ^ "<THEORY>\n" ^ 

    theref2xml (i+i) (theory2theory' thy) "Theorems" "" ^

    indt i ^ "</THEORY>\n" ^

    (case met of [] => (indt i) ^ "<METHODS> </METHODS>\n"

	       | _ => (indt i) ^ "<METHODS>\n" ^

		      foldl op^ ("", map (keref2xml (i+i) Met_) met) ^

		      (indt i) ^ "</METHODS>\n") ^

    indt i ^ "<EVALPRECOND> " ^ (#id o rep_rls) 

				    prls ^ " </EVALPRECOND>\n" ^ 

    authors2xml i "MATHAUTHORS" mathauthors ^

    authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^

    "</NODECONTENT>" : xml;

(* 

val pblID = ["linear","univariate","equation"];

val pblID = ["degree_4","polynomial","univariate","equation"];

writeln (pbl2xml pblID (get_pbt pblID));

*)

(*replace by 'fun calc2xml' as developed for thy in 0607*)

fun calc2xmlOLD j ((scr_op, (isa_op, _)):calc) =

    indt i ^ "<CALCULATE> (" ^ scr_op ^ ", (" ^ isa_op ^ ")) </CALCULATE>\n";

fun calcs2xmlOLD j [] = ("":xml) (*TODO replace with 'strs2xml'*)

  | calcs2xmlOLD j (r::rs) = calc2xmlOLD j r ^ calcs2xmlOLD j rs;

(*.format a method in xml for presentation on the method browser;

   new version with <KESTOREREF>s -- not used because linking

   requires elements (rls, calc, ...) to be reorganized.*)

(*######## ATTENTION: THIS IS not THE ACTUAL VERSION ################*)

fun met2xml (id:metID) ({guh,mathauthors,init,ppc,pre,scr,calc,

			 crls,erls,errpats,nrls,prls,srls,rew_ord'}:met) =

    let val thy' = "Isac" (*FIXME.WN0607 get thy from met ?!?*)

	val crls' = (#id o rep_rls) crls

	val erls' = (#id o rep_rls) erls

	val nrls' = (#id o rep_rls) nrls

	val prls' = (#id o rep_rls) prls

	val srls' = (#id o rep_rls) srls

    in "<NODECONTENT>\n" ^

       indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^

       id2xml i id ^ 

       indt i ^ "<META> </META>\n" ^

       scr2xml i scr ^

       pattern2xml i ppc pre ^

       indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^

       indt i ^ "<EVALPRECOND>\n" ^ 

       theref2xml (i+i) (snd (thy_containing_rls thy' prls')) "Rulesets" prls'^

       indt i ^ "</EVALPRECOND>\n" ^

       indt i ^ "<EVALCOND>\n"    ^ 

       theref2xml (i+i) (snd (thy_containing_rls thy' erls')) "Rulesets" erls'^

       indt i ^ "</EVALCOND>\n" ^

       indt i ^ "<EVALLISTEXPR>\n"^ 

       theref2xml (i+i) (snd (thy_containing_rls thy' srls')) "Rulesets" srls'^

       indt i ^ "</EVALLISTEXPR>\n" ^

       indt i ^ "<CHECKELEMENTWISE>\n" ^ 

       theref2xml (i+i) (snd (thy_containing_rls thy' crls')) "Rulesets" crls'^

       indt i ^ "</CHECKELEMENTWISE>\n" ^

       indt i ^ "<NORMALFORM>\n"  ^ 

       theref2xml (i+i) (snd (thy_containing_rls thy' nrls')) "Rulesets" nrls'^

       indt i ^ "</NORMALFORM>\n" ^

       indt i ^ "<REWORDER> " ^ rew_ord' ^ " </REWORDER>\n" ^

       calcs2xmlOLD i calc ^

       authors2xml i "MATHAUTHORS" mathauthors ^

       authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^

       "</NODECONTENT>" : xml

    end;

(*.format a method in xml for presentation on the method browser;

   old version with 'dead' strings for rls, calc, ....*)

fun met2xml (id:metID) ({guh,mathauthors,init,ppc,pre,scr,calc,

			 crls,erls,errpats,nrls,prls,srls,rew_ord'}:met) =

    "<NODECONTENT>\n" ^

    indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^

    id2xml i id ^ 

    indt i ^ "<META> </META>\n" ^

    scr2xml i scr ^

    pattern2xml i ppc pre ^

    indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^

    indt i ^ "<EVALPRECOND> " ^  (#id o rep_rls) prls ^ " </EVALPRECOND>\n" ^

    indt i ^ "<EVALCOND> " ^ (#id o rep_rls) erls ^ " </EVALCOND>\n" ^

    indt i ^ "<EVALLISTEXPR> "^ (#id o rep_rls) srls ^ " </EVALLISTEXPR>\n" ^

    indt i ^ "<CHECKELEMENTWISE> " ^ (#id o rep_rls) 

					 crls ^ " </CHECKELEMENTWISE>\n" ^

    indt i ^ "<NORMALFORM> "  ^ (#id o rep_rls) nrls ^ " </NORMALFORM>\n" ^

    indt i ^ "<REWORDER> " ^ rew_ord' ^ " </REWORDER>\n" ^

    calcs2xmlOLD i calc ^

    authors2xml i "MATHAUTHORS" mathauthors ^

    authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^

    "</NODECONTENT>" : xml;

(* writeln (met2xml ["Test", "solve_linear"]

		    (get_met ["Test", "solve_linear"]));

   *)

(**. write pbls from hierarchy to files.**)

(*.write the files using an int-key (pos') as filename.*)

fun pbl2file (path:path) (pos:pos) (id:metID) (pbl as {guh,...}) =

    (writeln ("### pbl2file: id = " ^ strs2str id);

    ((str2file (path ^ pos2filename pos)) o (pbl2xml id)) pbl

    );

(*.write the files using the guh as filename.*)

(*    *)

fun pbl2file (path:path) (pos:pos) (id:metID) (pbl as {guh,...}) =

    (writeln ("### pbl2file: id = " ^ strs2str id ^ ", pos = " ^ pos2str pos);

     ((str2file (path ^ guh2filename guh)) o (pbl2xml id)) pbl

     );

(**. write mets from hierarchy to files.**)

(*.write the files using an int-key (pos') as filename.*)

fun met2file (path:path) (pos:pos) (id:metID) met =

    (writeln ("### met2file: id = " ^ strs2str id);

     ((str2file (path ^ "met" ^ pos2filename pos)) o (met2xml id)) met);

(*.write the files using the guh as filename.*)

fun met2file (path:path) (pos:pos) (id:metID) (met as {guh,...}) =

    (writeln ("### met2file: id = " ^ strs2str id);

     ((str2file (path ^ guh2filename guh)) o (met2xml id)) met);

(*.scan the mtree Ptyp and print the nodes using wfn.*)

fun node (pa:path) ids po wfn (Ptyp (id,[n],ns)) = 

    let val po' = lev_on po

    in

      wfn pa po' (ids@[id]) n; 

      nodes pa (ids@[id]) ((lev_dn po'):pos) wfn ns

    end

and nodes _ _ _ _ [] = ()

  | nodes pa ids po wfn (n::ns) =

      (node pa ids po wfn n; nodes pa ids (lev_on po) wfn ns);

fun pbls2file (p:path) = nodes p [] [0] pbl2file (get_ptyps ());

fun mets2file (p:path) = nodes p [] [0] met2file (get_mets ());

(*

val path = "/home/neuper/proto2/isac/xmldata/"; 

val path = "/home/neuper/tmp/"; 

pbl_hierarchy2file (path ^ "pbl/");

pbls2file          (path ^ "pbl/");

met_hierarchy2file (path ^ "met/");

mets2file          (path ^ "met/");

thy_hierarchy2file (path ^ "thy/");

thes2file          (path ^ "thy/");

*)

fun update_metdata

  ({guh, mathauthors, init, rew_ord', erls, srls, prls, crls, nrls, calc, ppc, pre, scr, ...}: met)

    errpats' =

  {guh = guh, mathauthors = mathauthors, init = init, rew_ord' = rew_ord', erls = erls,

    srls = srls, prls = prls, crls = crls, nrls = nrls, calc = calc,

    ppc = ppc, pre = pre, scr = scr, errpats = errpats'}: met

fun update_metpair metID errpats = let

        val ret = (update_metdata (get_met metID) errpats, metID)

          handle ERROR _ => error ("update_metpair: " ^ (strs2str metID) ^ "must address a method");

      in ret end;