(*
    ||M||  This file is part of HELM, an Hypertextual, Electronic        
    ||A||  Library of Mathematics, developed at the Computer Science     
    ||T||  Department, University of Bologna, Italy.                     
    ||I||                                                                
    ||T||  HELM is free software; you can redistribute it and/or         
    ||A||  modify it under the terms of the GNU General Public License   
    \   /  version 2 or (at your option) any later version.              
     \ /   This software is distributed as is, NO WARRANTY.              
      V_______________________________________________________________ *)

module F = Filename
module U = NUri
module H = Hierarchy

type 'a out = (unit -> 'a) -> string -> 'a

(* internal functions *******************************************************)

let base = "xml"

let obj_ext = ".xml"

let system = "http://helm.cs.unibo.it/lambda-delta/" ^ base ^ "/ld.dtd"

let path_of_uri uri =
   F.concat base (Str.string_after (U.string_of_uri uri) 3)

let pp_head frm = 
   Format.fprintf frm "<?xml version=%S encoding=%S?>@,@," "1.0" "UTF-8"

let pp_doctype frm =
  Format.fprintf frm "<!DOCTYPE ENTRY SYSTEM %S>@,@," system

let open_entry si g frm =
   let opts = if si then "si" else "" in
   let f shp =
      Format.fprintf frm "<ENTRY hierarchy=%S options=%S>" shp opts
   in
   H.string_of_graph f g

let close_entry frm =
   Format.fprintf frm "</ENTRY>" 

(* interface functions ******************************************************)

let old_export_entity export_entry si g = function
   | Some entry ->
      let _, uri, bind = entry in
      let path = path_of_uri uri in
      let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
      let och = open_out (path ^ obj_ext) in
      let frm = Format.formatter_of_out_channel och in
      Format.pp_set_margin frm max_int;
      Format.fprintf frm "@[<v>%t%t%t%a%t@]@." 
         pp_head pp_doctype (open_entry si g) export_entry entry close_entry;  
      close_out och
   | None     -> ()

(****************************************************************************)
(*
let export_entity export_entry si g = function
   | Some entry ->
      let _, uri, bind = entry in
      let path = path_of_uri root uri in
      let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
      let och = open_out (path ^ obj_ext) in
      let out f s = output_string och s; f () in
      let f () = close_out och in
      
      Format.fprintf frm "@[<v>%t%t%t%a%t@]@." 
         pp_head pp_doctype (open_entry si g) export_entry entry close_entry;  
      close_out och
   | None     -> ()
*)