7 type value_t
= string * Sql.Type.t
(** name and type *)
10 type values
= value_t list
18 | OneOf
of string * string (** column,table *)
19 | One
of string (** column *)
22 type columns
= column list deriving
(Show
)
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
)
30 type kind = | Select of column_list
31 | Insert of column_list
32 | Create of Sql.Table.t
33 | Update of column_list
38 * string (** table name as string *)
39 * values
(** placeholders for input parameters *)
43 * string (** table name as string *)
44 * values
(** placeholders for input parameters *)
45 * Props.t
(** some user directives *)
46 * string (** raw sql untouched *)
49 let to_sql k table sql
=
54 (String.concat
"," (List.map
(fun _
-> "?") table
.Sql.Table.cols
))
55 | Insert
(Cols cols
) ->
58 (String.concat
"," (List.map
(fun _
-> "?") cols
))
64 let to_sql k table sql
=
67 | c
-> String.make
1 c
69 String.replace_chars
escape (to_sql k table sql
)
75 type column = Sql.Col.t * Sql.Table.t
78 type kind = | Select of column list (** rowset *)
79 * values
(** rowset expressions *)
80 * values
(** input parameters *)
82 | Modify
of column list
(** modified columns *)
83 * values
(** input parameters *)
84 | Delete
of values
(** input parameters *)
88 * Sql.Table.t
(** this is temporary workaround *)
89 * Props.t
(** some user directives *)
90 * string (** corresponding SQL query *)
93 exception Bad_column
of Sql.Table.t
* string
95 (** resolve all names given as strings to corresponding values *)
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
=
103 | Raw.All
-> List.map
(fun col
-> col
,table
) table
.Sql.Table.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
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
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
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
))
134 Bad_column
(table
,column
) ->
135 Error.log
"Column %s not found in %s" column table
.Sql.Table.name
;
139 List.filter_map
resolve_one stmts