helm/software/lambda-delta/common/library.ml

   1 (*
   2     ||M||  This file is part of HELM, an Hypertextual, Electronic
   3     ||A||  Library of Mathematics, developed at the Computer Science
   4     ||T||  Department, University of Bologna, Italy.
   5     ||I||
   6     ||T||  HELM is free software; you can redistribute it and/or
   7     ||A||  modify it under the terms of the GNU General Public License
   8     \   /  version 2 or (at your option) any later version.
   9      \ /   This software is distributed as is, NO WARRANTY.
  10       V_______________________________________________________________ *)
  11
  12 module F = Filename
  13 module U = NUri
  14 module H = Hierarchy
  15
  16 type 'a out = (unit -> 'a) -> string -> 'a
  17
  18 (* internal functions *******************************************************)
  19
  20 let base = "xml"
  21
  22 let obj_ext = ".xml"
  23
  24 let system = "http://helm.cs.unibo.it/lambda-delta/" ^ base ^ "/ld.dtd"
  25
  26 let path_of_uri uri =
  27    F.concat base (Str.string_after (U.string_of_uri uri) 3)
  28
  29 let pp_head frm =
  30    Format.fprintf frm "<?xml version=%S encoding=%S?>@,@," "1.0" "UTF-8"
  31
  32 let pp_doctype frm =
  33   Format.fprintf frm "<!DOCTYPE ENTRY SYSTEM %S>@,@," system
  34
  35 let open_entry si g frm =
  36    let opts = if si then "si" else "" in
  37    let f shp =
  38       Format.fprintf frm "<ENTRY hierarchy=%S options=%S>" shp opts
  39    in
  40    H.string_of_graph f g
  41
  42 let close_entry frm =
  43    Format.fprintf frm "</ENTRY>"
  44
  45 (* interface functions ******************************************************)
  46
  47 let old_export_entity export_entry si g = function
  48    | Some entry ->
  49       let _, uri, bind = entry in
  50       let path = path_of_uri uri in
  51       let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
  52       let och = open_out (path ^ obj_ext) in
  53       let frm = Format.formatter_of_out_channel och in
  54       Format.pp_set_margin frm max_int;
  55       Format.fprintf frm "@[<v>%t%t%t%a%t@]@."
  56          pp_head pp_doctype (open_entry si g) export_entry entry close_entry;
  57       close_out och
  58    | None     -> ()
  59
  60 (****************************************************************************)
  61 (*
  62 let export_entity export_entry si g = function
  63    | Some entry ->
  64       let _, uri, bind = entry in
  65       let path = path_of_uri root uri in
  66       let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
  67       let och = open_out (path ^ obj_ext) in
  68       let out f s = output_string och s; f () in
  69       let f () = close_out och in
  70
  71       Format.fprintf frm "@[<v>%t%t%t%a%t@]@."
  72          pp_head pp_doctype (open_entry si g) export_entry entry close_entry;
  73       close_out och
  74    | None     -> ()
  75 *)