(**************************************************************************)
(*                   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                                *)
(**************************************************************************)

(** Types to describe a schema. *)

module M = Dbf_messages

module V1 =
  struct
    (** Type of keys. *)
    type t_key = Primary_key | Key

    (** SQL code is a string. *)
    type sql_code = string

    (** The various supported DBMS. *)
    type dbms = Odbc | Mysql | Postgres

    (** Column info for a specific dbms. *)
    type column_dbms = {
	mutable col_type_sql : string * string option * string option ;
        (** SQL type, an optional argument, and optional args *)

	mutable col_2ml : string ;
        (** Name of the function to call to get a ml value from a string *)

	mutable col_ml2 : string ;
        (** Name of the function to call to get a strign from a ml value *)

	mutable col_key : t_key option ;
        (** optional key type *)
	
	mutable col_default : sql_code option ;
        (** optional default SQL value *)

	mutable col_atts : (string * sql_code) list ;
        (** list of (attribute name, SQL code for value) *)
      } 

    (** A table column. *)
    type column = {
	mutable col_name : string ;
         (** Name of the column, will also be the name
	    of the record in the ocaml record type of the table *)

	mutable col_comment : string;
        (** Comment of the column *)

	mutable col_type_ml : string; 
        (** OCaml type to represent the SQL type *)

	mutable col_nullable : bool;
        (** column can contain NULL values or not *)

	mutable col_index : bool ;
        (** make an index on this column or not *)

	mutable col_dbms : (dbms * column_dbms) list
        (** DBMS-specific information *)
      } 

    (** A table. *)
    type table = {
	mutable ta_name : string ;
	mutable ta_comment : string ; 
	mutable ta_columns : column list ;
	mutable ta_atts : int list ; (** later, table attributes *)
	mutable ta_indexes : int list ; (** later, indexes on various columns *)
      } 

    (** A schema. *)
    type schema = {
	mutable sch_tables : table list;
      } 


    (** To describe attributes. *)
    type att_desc =
	Att_string 

    let default () = { sch_tables = [] }

    let version = "1"

    let read chanin =
      try
        let tree = IoXML.parse_xml (Stream.of_channel chanin) in
        xparse_schema tree
      with
        e ->
          let e =
            match e with
              IoXML.ExcLoc ((bp,ep), e) ->
                prerr_endline (M.error_at_location bp ep)
            | e ->
                prerr_endline (Printexc.to_string e)
          in
	  default ()

    let write chanout v =
      let fmt = Format.formatter_of_out_channel chanout in
      Format.pp_open_box fmt 0;
      xprint_schema fmt v;
      Format.pp_close_box fmt ();
      Format.pp_print_flush fmt ()
  end

module Current = V1

let readers = [ "1", V1.read ]

let current_version = Current.version

let write file ff =
  try
    let chanout = open_out file in
    output_string chanout (current_version^"\n");
    Current.write chanout ff;
    close_out chanout
  with
    Sys_error s -> 
      raise (Failure s)

let read file =
  try
    if Sys.file_exists file then
      let chanin = open_in file in
      let l = input_line chanin in
      let reader =
	try List.assoc l readers
	with Not_found -> 
	  (** let's try with the old input value reader *)
	  (fun chanin ->
	    seek_in chanin 0;
	    V1.read chanin
	  )
      in
      try
	let f = reader chanin in 
	close_in chanin; 
	f
      with e -> 
	close_in chanin ; 
	raise e
    else
      (
       let f = Current.default () in
       write file f;
       f
      )
  with
    Sys_error s -> 
      raise (Failure s)
  | End_of_file ->
      Current.default ()

