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