(**************************************************************************)
(*                   Cameleon                                             *)
(*                                                                        *)
(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
(*      en Automatique. All rights reserved.                              *)
(*                                                                        *)
(*      This program is free software; you can redistribute it and/or modify  *)
(*      it under the terms of the GNU General Public License as published by  *)
(*      the Free Software Foundation; either version 2 of the License, or  *)
(*      any later version.                                                *)
(*                                                                        *)
(*      This program is distributed in the hope that it will be useful,   *)
(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
(*      GNU General Public License for more details.                      *)
(*                                                                        *)
(*      You should have received a copy of the GNU General Public License  *)
(*      along with this program; if not, write to the Free Software       *)
(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
(*      02111-1307  USA                                                   *)
(*                                                                        *)
(*      Contact: Maxence.Guesdon@inria.fr                                *)
(**************************************************************************)

(*[Ty] The type used to represent "xml" items. [Ty]*)
type item = 
    Simple_item of string * string  (* the mark and the value *)
  | Subitems of string * item list (* the mark and the subitems *)

(*[Fonc] This function takes an item and return the string
   which represents this item, syntaxically correct.[Fonc]*)
let string_of_item item =
  let rec iter_list = function
      [] ->
	""
    | item :: q ->
	match item with
	  Simple_item (mark, v) ->
	    "<"^mark^">"^v^"</"^mark^">"
	| Subitems (mark, l) ->
	    let s = List.fold_left
		(fun acc -> fun i -> acc^"\n"^(iter_list [i]))
		""
		l
	    in
	    "<"^mark^">"^s^"\n</"^mark^">"
  in
  iter_list [item]

(*[Si] The signature of the Converter module in parameter
   of DocumentIO.[Si]*)
module type Converter =
  sig
    type t
    val t_of_item : item -> t
    val item_of_t : t -> item
  end

(*[Si] The signature of modules used to parse and get items.[Si]*)
module type Parser =
  sig
    val init : unit -> unit
    val parse : Lexing.lexbuf -> item
  end

(*[Fu] The functor used to create read and write modules
   for "xml" documents.[Fu]*)
module DocumentIO =
    functor (MyParser : Parser) ->
      functor (MyConverter : Converter) ->
  struct
    (*[Fonc] This function takes a filename and returns
       the Converter.t value parsed from the file.[Fonc]*)
    let read_file file = 
      try
	let chanin = open_in file in
	let lexbuf = Lexing.from_channel chanin in
	MyParser.init ();
	let item = MyParser.parse lexbuf in
	MyConverter.t_of_item item
      with
	Sys_error s ->
	  raise (Failure s)

    (*[Fonc] This function takes a string and returns
       the Converter.t value parsed from the string.[Fonc]*)
    let read_string s =
      let lexbuf = Lexing.from_string s in
      MyParser.init ();
      let item = MyParser.parse lexbuf in
      MyConverter.t_of_item item

    (*[Fonc] This function takes a Converter.t value and
       returns the string which represents the value.[Fonc]*)
    let write_string (data : MyConverter.t) =
       let item = MyConverter.item_of_t data in
       string_of_item item

    (*[Fonc] This function takes a filename and a Converter.t value and
       outputs into the file the string which represents the value.[Fonc]*)
    let write_file file (data : MyConverter.t) =
      try
	let chanout = open_out file in
	output_string chanout (write_string data);
	close_out chanout
      with
	Sys_error s ->
	  raise (Failure s)
  end

