stmt.ml

   1 (* $Id$ *)
   2
   3 open Printf
   4 open ExtString
   5 open ListMore
   6
   7 type value_t = string * Sql.Type.t (** name and type *)
   8      deriving (Show)
   9
  10 type values = value_t list
  11 deriving (Show)
  12
  13 module Raw =
  14 struct
  15   type param_id = | Named of string | Numbered of int | Next deriving (Show)
  16   type param_type = Sql.Type.t option deriving (Show)
  17   type param = param_id * param_type deriving (Show)
  18   type params = param list deriving (Show)
  19
  20   let to_string ps = Show.show<params>(ps)
  21
  22 (*
  23   type kind = | Select of column_list
  24               | Insert of column_list
  25               | Create of Sql.Table.t
  26               | Update of column_list
  27               | Delete
  28        deriving (Show)
  29
  30   type parsed = kind
  31                 * string  (** table name as string *)
  32                 * values  (** placeholders for input parameters *)
  33        deriving (Show)
  34
  35   type t = kind
  36            * string  (** table name as string *)
  37            * values  (** placeholders for input parameters *)
  38            * Props.t (** some user directives *)
  39            * string  (** raw sql untouched *)
  40        deriving (Show)
  41
  42 let to_sql k table sql =
  43   match k with
  44   | Insert All ->
  45       sprintf "%s (%s)"
  46         sql
  47         (String.concat "," (List.map (fun _ -> "?") table.Sql.Table.cols))
  48   | Insert (Cols cols) ->
  49       sprintf "%s (%s)"
  50         sql
  51         (String.concat "," (List.map (fun _ -> "?") cols))
  52   | Delete
  53   | Update _
  54   | Create _
  55   | Select _ -> sql
  56
  57 let to_sql k table sql =
  58   let escape = function
  59   | '\n' -> "\\\n"
  60   | c -> String.make 1 c
  61   in
  62   String.replace_chars escape (to_sql k table sql)
  63
  64 *)
  65 end (* module Raw *)
  66
  67 (*
  68 type column = Sql.Col.t * Sql.Table.t
  69      deriving (Show)
  70
  71 type kind = | Select of column list (** rowset *)
  72                         * values (** rowset expressions *)
  73                         * values (** input parameters *)
  74             | Create
  75             | Modify of column list (** modified columns *)
  76                         * values (** input parameters *)
  77             | Delete of values (** input parameters *)
  78      deriving (Show)
  79
  80 type t = kind
  81          * Sql.Table.t (** this is temporary workaround *)
  82          * Props.t     (** some user directives *)
  83          * string      (** corresponding SQL query *)
  84      deriving (Show)
  85
  86 exception Bad_column of Sql.Table.t * string
  87
  88 (** resolve all names given as strings to corresponding values *)
  89 let resolve stmts =
  90   let tables = ref [] in
  91   let get_table name = List.find_option (fun table -> table.Sql.Table.name = name) !tables in
  92   let get_column table name = List.find_option (fun col -> col.Sql.Col.name = name) table.Sql.Table.cols in
  93   (* fix here for multiple tables *)
  94   let resolve_columns table columns =
  95     match columns with
  96     | Raw.All -> List.map (fun col -> col,table) table.Sql.Table.cols
  97     | Raw.Cols cols ->
  98         List.map (fun colname -> match get_column table colname with
  99                                  | Some col -> col, table
 100                                  | None -> raise (Bad_column (table,colname))) cols
 101   in
 102   let resolve_one stmt =
 103     let (kind,name,inputs,props,raw_sql) = stmt in
 104     let sql table = Raw.to_sql kind table raw_sql in
 105     match get_table name with
 106     | None ->
 107         begin match kind with
 108         | Raw.Create table ->
 109             tables := table::!tables;
 110             assert (List.length inputs = 0);
 111             Some (Create, table, props, sql table)
 112         | _ -> Error.log "No such table %s" name; None
 113         end
 114     | Some table ->
 115         begin try
 116           (match kind with
 117           | Raw.Create _ -> Error.log "Duplicate CREATE for table %s" name; None
 118           | Raw.Select colnames ->
 119               let outputs = resolve_columns table colnames in
 120               Some (Select (outputs,[],inputs), table, props, sql table)
 121           | Raw.Insert colnames
 122           | Raw.Update colnames ->
 123               let cols = resolve_columns table colnames in
 124               Some (Modify (cols,inputs), table, props, sql table)
 125           | Raw.Delete -> Some (Delete inputs, table, props, sql table))
 126           with
 127             Bad_column (table,column) ->
 128               Error.log "Column %s not found in %s" column table.Sql.Table.name;
 129               None
 130         end
 131   in
 132   List.filter_map resolve_one stmts
 133 *)