syntax.ml

   1 (* SQL syntax and RA *)
   2
   3 open Stmt
   4 open Operators
   5 open ListMore
   6 open Apply
   7
   8 type expr = [ `Value of Sql.Type.t (** literal value *)
   9             | `Param of param
  10             | `Func of Sql.Type.t option * expr list (** return type, parameters *)
  11             | `Column of string * string option (** name, table *)
  12             ]
  13             deriving (Show)
  14
  15 type expr_q = [ `Value of Sql.Type.t (** literal value *)
  16             | `Param of param
  17             | `Func of Sql.Type.t option * expr_q list (** return type, parameters *)
  18             ]
  19             deriving (Show)
  20
  21 let expr_to_string = Show.show<expr>
  22
  23 type column =
  24   | All
  25   | AllOf of string
  26   | Expr of expr * string option (** name *)
  27   deriving (Show)
  28
  29 type columns = column list deriving (Show)
  30
  31 let collect f l = List.flatten (List.map f l)
  32
  33 (* FIXME *)
  34 let schema_as_params = List.map (fun attr -> (Some attr.RA.name,(0,0)), Some attr.RA.domain)
  35
  36 (** replace every Column with Value of corresponding type *)
  37 let resolve_columns tables joined_schema expr =
  38   let schema name = name >> Tables.get_from tables >> snd in
  39   let rec each e =
  40     match e with
  41     | `Value x -> `Value x
  42     | `Column (name,x) ->
  43       let attr = RA.Schema.find (Option.map_default schema joined_schema x) name in
  44       `Value attr.RA.domain
  45     | `Param x -> `Param x
  46     | `Func (r,l) -> `Func (r,(List.map each l))
  47   in
  48   each expr
  49
  50 (** assign types to parameters where possible *)
  51 let assign_types expr =
  52   let rec typeof e = (* FIXME simplify *)
  53     match e with
  54     | `Value t -> e, Some t
  55     | `Func (ret,l) ->
  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
  60         | [] -> None
  61         | h::t -> if List.for_all ((=) h) t then Some h else None
  62         in
  63 (*
  64         print_endline (Show.show<expr_q list>(l));
  65         print_endline (Show.show<Sql.Type.t option>(t));
  66 *)
  67         let assign = function
  68         | `Param (n,None) -> `Param (n,t)
  69         | x -> x
  70         in
  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
  74   in
  75   typeof expr
  76
  77 let show_e e = Show.show<expr_q> (e) >> print_endline
  78
  79 let resolve_types tables joined_schema expr =
  80   expr
  81   >> resolve_columns tables joined_schema
  82 (*   >> tee show_e  *)
  83   >> assign_types
  84
  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
  90     | AllOf t -> schema t
  91     | Expr (e,name) ->
  92       let col = begin
  93       match e with
  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))
  97       end in
  98       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
  99       [ col ]
 100   in
 101   collect resolve1 columns
 102
 103 let get_params e =
 104   let rec loop acc e =
 105     match e with
 106     | `Param p -> p::acc
 107     | `Func (_,l) -> List.fold_left loop acc l
 108     | `Value _ -> acc
 109   in
 110   loop [] e >> List.rev
 111
 112 let get_params tables joined_schema e =
 113   e >> resolve_types tables joined_schema >> fst >> get_params
 114
 115 (*
 116 let _ =
 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
 119 *)
 120
 121 let params_of_column tables j_s = function
 122   | All | AllOf _ -> []
 123   | Expr (e,_) -> get_params tables j_s e
 124
 125 let params_of_columns tables j_s = collect (params_of_column tables j_s)
 126
 127 let get_params_opt tables j_s = function
 128   | Some x -> get_params tables j_s x
 129   | None -> []
 130
 131 let get_params_l tables j_s l = collect (get_params tables j_s) l
 132
 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
 137   | `Cross
 138   | `Search _
 139   | `Default -> RA.Schema.cross schema schema1
 140   | `Natural -> RA.Schema.natural schema schema1
 141   | `Using l -> RA.Schema.join_using l schema schema1
 142   in
 143   let p = match kind with
 144   | `Cross | `Default | `Natural | `Using _ -> []
 145   | `Search e -> get_params tables schema e
 146   in
 147   tables,params @ params1 @ p , schema
 148
 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)
 153
 154 let split_column_assignments schema l =
 155   let cols = ref [] in
 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)
 163