lib/tables.ml

   1 (** Global list of tables *)
   2
   3 open Printf
   4 open ExtLib
   5
   6 type table = Sql.table
   7
   8 let all : table list ref = ref []
   9
  10 (** FIXME table names case sensitivity? *)
  11 (* NB compares with db name *)
  12 let by_name (name:Sql.table_name) = fun (n,_) -> n = name
  13
  14 (** @raise Error when no such table *)
  15 let get_from tables name =
  16   try
  17     List.find (by_name name) tables
  18   with Not_found -> failwith (sprintf "no such table %s" (Sql.show_table_name name))
  19
  20 let get name = get_from !all name
  21 let get_schema name = snd (get name)
  22 let check name = ignore (get name)
  23
  24 let add v =
  25   let (name,_) = v in
  26   match List.find_all (by_name name) !all with
  27   | [] -> all := v :: !all
  28   | _ -> failwith (sprintf "table %s already exists" (Sql.show_table_name name))
  29
  30 let drop name = check name; all := List.remove_if (by_name name) !all
  31
  32 let rename oldname newname =
  33   let (_,t) = get oldname in
  34   add (newname,t);
  35   drop oldname
  36
  37 let alter name f =
  38   check name;
  39   let alter_schema ((n,s) as table) =
  40     if n = name then
  41       name, f s
  42     else
  43       table
  44   in
  45   all := List.map alter_schema !all
  46
  47 let alter_add name col pos = alter name (fun s -> Sql.Schema.add s col pos)
  48 let alter_drop name col = alter name (fun s -> Sql.Schema.drop s col)
  49 let alter_change name oldcol col pos = alter name (fun s -> Sql.Schema.change s oldcol col pos)
  50 let rename_column name oldcol newcol = alter name (fun s -> Sql.Schema.rename s oldcol newcol)
  51
  52 let print ch tables = let out = IO.output_channel ch in List.iter (Sql.print_table out) tables; IO.flush out
  53 let print_all () = print stdout !all
  54 let print1 name = print stdout [get @@ Sql.make_table_name name] (* TODO allow db.name too *)
  55
  56 let reset () = all := []
  57
  58 let all () = !all