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

(** Generating classes to access the tables. *)

open Dbf_types.Current

let pr = Format.fprintf

let get_primary_key_col_name dbms t =
  try
    let col = List.find 
	(fun c -> 
	  try
	    let coldbms = List.assoc dbms c.col_dbms in
	    coldbms.col_key = Some Primary_key
	  with
	    Not_found -> false
	)
	t.ta_columns
    in
    Some col.col_name
  with
    Not_found -> None


let column_default_value dbms col =
  if col.col_nullable then 
    "None"
  else 
    try
      let cdbms = List.assoc dbms col.col_dbms in
      "("^cdbms.col_2ml^" "^
      (match cdbms.col_default with
	None -> "\"\""
      |	Some s -> "\""^s^"\""
      )^
      ")"
    with
      Not_found ->
	"\"\" (* no info for this dbms *)"

let gen_one_field fmt dbms key col =
  pr fmt
    "    val %s%s = %s\n"
    (if col.col_name = key then "" else "mutable ")
    col.col_name
    (column_default_value dbms col);

  pr fmt 
    "    method %s = %s\n"
    col.col_name
    col.col_name;

  if col.col_name = key then
    ()
  else
    pr fmt 
      "    method set_%s %s__ = %s <- %s__\n"
      col.col_name
      col.col_name
      col.col_name
      col.col_name;

  pr fmt "\n"
     

let gen_fields fmt dbms t key =
  List.iter (gen_one_field fmt dbms key) t.ta_columns

let gen_update fmt m t key =
  pr fmt "    method update = \n";
  pr fmt "      %s.update db ~key_%s: %s\n" m key key;

  List.iter
    (fun col ->
      if col.col_name <> key then
	pr fmt "        ~%s\n" col.col_name
      else
	()
    )
    t.ta_columns;

  pr fmt "        ()\n\n"

let gen_delete fmt m t key =
  pr fmt "    method delete = \n";
  pr fmt "      %s.delete db \n" m;

  if key <> "" then
    pr fmt "        ~%s\n" key
  else
    List.iter
      (fun col ->
	pr fmt "        ~%s\n" col.col_name
      )
      t.ta_columns;

  pr fmt "        ()\n\n"

let gen_insert fmt m t key =
  pr fmt "    method insert = \n";
  pr fmt "      %s.insert db \n" m;

  List.iter
    (fun col ->
      pr fmt "        ~%s\n" col.col_name
    )
    t.ta_columns;
  
  pr fmt "        ()\n\n"

let gen_class fmt dbms t =
  let m = String.capitalize t.ta_name in
  let key_opt = get_primary_key_col_name dbms t in
  let key = match key_opt with None -> "" | Some s -> s in

  pr fmt "class %s db =\n" t.ta_name;
  pr fmt "  object(self)\n" ;

  gen_fields fmt dbms t key ;

  if key = "" then () else gen_update fmt m t key;

  gen_delete fmt m t key ;
  gen_insert fmt m t key ;

  pr fmt "  end\n\n"


let generate fmt interface_module dbms schema =
  pr fmt "open %s\n\n" interface_module ;

  List.iter (gen_class fmt dbms) schema.sch_tables
