1 (* SQL syntax and RA *)
8 type expr
= [ `Value
of Sql.Type.t
(** literal value *)
10 | `Func
of Sql.Type.t
option * expr list
(** return type, parameters *)
11 | `Column
of string * string option (** name, table *)
15 type expr_q
= [ `Value
of Sql.Type.t
(** literal value *)
17 | `Func
of Sql.Type.t
option * expr_q list
(** return type, parameters *)
21 let expr_to_string = Show.show
<expr
>
26 | Expr
of expr
* string option (** name *)
29 type columns
= column list deriving
(Show
)
31 let collect f l
= List.flatten
(List.map f l
)
34 let schema_as_params = List.map
(fun attr
-> (Some attr
.RA.name
,(0,0)), Some attr
.RA.domain
)
36 (** replace every Column with Value of corresponding type *)
37 let resolve_columns tables joined_schema expr
=
38 let schema_of_table name
= name
>> Tables.get_from tables
>> snd
in
41 | `Value x
-> `Value x
42 | `Column
(name
,table
) ->
43 let attr = RA.Schema.find
(Option.map_default
schema_of_table joined_schema table
) name
in
45 | `Param x
-> `Param x
46 | `Func
(r
,l
) -> `Func
(r
,(List.map
each l
))
50 (** assign types to parameters where possible *)
51 let assign_types expr
=
52 let rec typeof e
= (* FIXME simplify *)
54 | `Value t
-> e
, Some t
56 (** Assumption: sql functions/operators have type schema 'a -> ... -> 'a -> 'a -> 'b
57 i.e. all parameters of some equal type *)
58 let (l
,t
) = l
>> List.map
typeof >> List.split
in
59 let t = match List.filter_valid
t with
61 | h
::t -> if List.for_all
((=) h
) t then Some h
else None
64 print_endline (Show.show<expr_q list>(l));
65 print_endline (Show.show<Sql.Type.t option>(t));
68 | `Param
(n
,None
) -> `Param
(n
,t)
71 let ret = if Option.is_some
ret then ret else t in
72 `Func
(ret,(List.map
assign l
)),ret
73 | `Param
(_
,t) -> e
, t
77 let show_e e
= Show.show
<expr_q
> (e
) >> print_endline
79 let resolve_types tables joined_schema expr
=
81 >> resolve_columns tables joined_schema
85 let infer_schema columns tables joined_schema
=
86 (* let all = tables >> List.map snd >> List.flatten in *)
87 let schema name
= name
>> Tables.get_from tables
>> snd
in
88 let resolve1 = function
89 | All
-> joined_schema
94 | `Column
(name
,Some
t) -> RA.Schema.find
(schema t) name
95 | `Column
(name
,None
) -> RA.Schema.find joined_schema name
96 | _
-> RA.attr "" (Option.default
Sql.Type.Text
(resolve_types tables joined_schema e
>> snd
))
98 let col = Option.map_default
(fun n
-> {col with RA.name
= n
}) col name
in
101 collect resolve1 columns
107 | `Func
(_
,l
) -> List.fold_left
loop acc l
110 loop [] e
>> List.rev
112 let get_params tables joined_schema e
=
113 e
>> resolve_types tables joined_schema
>> fst
>> get_params
117 let e = Sub [Value Sql.Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Sql.Type.Int);] in
118 e >> get_params >> to_string >> print_endline
121 let params_of_column tables j_s
= function
122 | All
| AllOf
_ -> []
123 | Expr
(e,_) -> get_params tables j_s
e
125 let params_of_columns tables j_s
= collect (params_of_column tables j_s
)
127 let get_params_opt tables j_s
= function
128 | Some x
-> get_params tables j_s x
131 let get_params_l tables j_s l
= collect (get_params tables j_s
) l
133 let do_join (tables
,params
,schema) ((table1
,params1
),kind
) =
134 let (_,schema1
) = table1
in
135 let tables = tables @ [table1
] in
136 let schema = match kind
with
139 | `Default
-> RA.Schema.cross
schema schema1
140 | `Natural
-> RA.Schema.natural
schema schema1
141 | `Using l
-> RA.Schema.join_using l
schema schema1
143 let p = match kind
with
144 | `Cross
| `Default
| `Natural
| `Using
_ -> []
145 | `Search
e -> get_params tables schema e
147 tables,params
@ params1
@ p , schema
149 let join ((t0
,p0
),joins
) =
150 let (tables,params
,joined_schema
) = List.fold_left
do_join ([t0
],p0
,snd t0
) joins
in
151 (* let joined_schema = tables >> List.map snd >> List.flatten in *)
152 (tables,params
,joined_schema)
154 let split_column_assignments schema l
=
156 let exprs = ref [] in
157 List.iter
(fun (col,expr
) ->
158 cols := col :: !cols;
159 (* hint expression to unify with the column type *)
160 let typ = (RA.Schema.find
schema col).RA.domain
in
161 exprs := (`Func
(None
, [`Value
typ;expr
])) :: !exprs) l
;
162 (List.rev
!cols,List.rev
!exprs)
164 let params_of_assigns t ss
=
165 let (_,exprs) = split_column_assignments (snd
t) ss
in
166 get_params_l [t] (snd
t) exprs