(******************************************************************************)
(*                                                                            *)
(*                               PROJECT HELM                                 *)
(*                                                                            *)
(*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
(*                                 28/12/2000                                 *)
(*                                                                            *)
(* This is the parser that reads the configuration file of helm               *)
(*                                                                            *)
(******************************************************************************)

let filename =
 try
  Sys.getenv "HELM_STYLECONFIGURATION_PATH"
 with
  Not_found ->
   let xml = "style-configuration.xml" in
   let tmp_xml = Configuration.tmp_dir ^ "/" ^ xml in
   let request_xml = Configuration.getter_url ^ "getstyleconf?uri=" ^ xml in
   ClientHTTP.get_and_save request_xml tmp_xml ;
   tmp_xml 

exception Warnings;;

class warner =
  object 
    method warn w =
      print_endline ("WARNING: " ^ w) ;
      (raise Warnings : unit)
  end
;;

let xml_document () =
 let module Y = Pxp_yacc in
  try 
   let config = {Y.default_config with Y.warner = new warner} in
    Y.parse_document_entity config (PxpUriResolver.from_file filename) Y.default_spec
  with
   e ->
     print_endline (Pxp_types.string_of_exn e) ;
     raise e
;;

exception Impossible;;

let styles = Hashtbl.create 13;;
let applies = Hashtbl.create 13;;

(* we trust the xml file to be valid because of the validating xml parser *)
let _ =
 List.iter
  (function
      n ->
       match n#node_type with
          Pxp_document.T_element "style" ->
           let key =
	    try
	     match n#attribute "key" with
	        Pxp_types.Value s -> s
	      | _ -> raise Impossible
	    with
	     Not_found -> n#data
	   in
            Hashtbl.add styles key n#data
        | Pxp_document.T_element "apply" ->
           let keys = List.map
            (function n ->
              match n#node_type with
                 Pxp_document.T_element "style-ref" ->
		  begin
		   match n#attribute "key" with
		      Pxp_types.Value s -> s
		    | _ -> raise Impossible
		  end
               | _ -> raise Impossible
            )
            n#sub_nodes
           in
	    let apply_name =
	     match n#attribute "name" with
	        Pxp_types.Value s -> s
	      | _ -> raise Impossible
	    in Hashtbl.add applies apply_name keys
        | _ -> raise Impossible
  )
  ((xml_document ())#root#sub_nodes)
;;

let style_of_key key =
 Hashtbl.find styles key

let key_list_of_mode_name name =
 Hashtbl.find applies name
;;