syntax.ml

   1 (* SQL syntax and RA *)
   2
   3 open Stmt
   4 open Operators
   5 open ListMore
   6
   7 type expr_q = [ `Value of Sql.Type.t
   8               | `Param of param
   9               | `Sub of expr_q list
  10               ]
  11               deriving (Show)
  12
  13 type expr = [ `Value of Sql.Type.t
  14             | `Param of param
  15             | `Sub of expr list
  16             | `Column of string * string option (** name, table *)
  17             ]
  18             deriving (Show)
  19
  20 let expr_to_string = Show.show<expr>
  21
  22 type column =
  23   | All
  24   | AllOf of string
  25   | Expr of expr * string option (** name *)
  26   deriving (Show)
  27
  28 type columns = column list deriving (Show)
  29
  30 let collect f l = List.flatten (List.map f l)
  31
  32 let get_scheme columns tables =
  33   let all = tables >> List.map snd >> List.flatten in
  34   let scheme name = name >> Tables.get_from tables >> snd in
  35   let resolve1 = function
  36     | All -> all
  37     | AllOf t -> scheme t
  38     | Expr (e,name) ->
  39       let col = begin
  40       match e with
  41       | `Column (name,Some t) -> RA.Scheme.find (scheme t) name
  42       | `Column (name,None) -> RA.Scheme.find all name
  43       | _ -> RA.attr "" Sql.Type.Text (* some expression *)
  44       end in
  45       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
  46       [ col ]
  47   in
  48   collect resolve1 columns
  49
  50 let scheme_as_params = List.map (fun attr -> Named attr.RA.name, Some attr.RA.domain)
  51
  52 (** replace every Column with Value of corresponding type *)
  53 let rebuild tables expr =
  54   let all = tables >> List.map snd >> List.flatten in
  55   let scheme name = name >> Tables.get_from tables >> snd in
  56   let rec each e =
  57     match e with
  58     | `Value x -> `Value x
  59     | `Column (name,x) ->
  60       let attr = RA.Scheme.find (Option.map_default scheme all x) name in
  61       `Value attr.RA.domain
  62     | `Param x -> `Param x
  63     | `Sub l -> `Sub (List.map each l)
  64   in
  65   each expr
  66
  67 (** assign types to parameters where possible *)
  68 let assign_types expr =
  69   let rec typeof e =
  70     match e with
  71     | `Value t -> e, Some t
  72     | `Sub l ->
  73         let t = match l >> List.map typeof >> List.map snd >> List.filter_valid with
  74         | [] -> None
  75         | h::t -> if List.for_all ((=) h) t then Some h else None
  76         in
  77         let assign = function
  78         | `Param (n,None) -> `Param (n,t)
  79         | x -> x
  80         in
  81         `Sub (List.map assign l), t
  82     | `Param (_,t) -> e, t
  83   in
  84   typeof expr >> fst
  85
  86 let get_params e =
  87   let rec loop acc e =
  88     match e with
  89     | `Param p -> p::acc
  90     | `Sub l -> List.fold_left loop acc l
  91     | `Column _ | `Value _ -> acc
  92   in
  93   loop [] e >> List.rev
  94
  95 let get_params tables (e:expr) =
  96   get_params (assign_types (rebuild tables e))
  97 (*   e >> rebuild tables >> assign_types >> get_params *)
  98
  99 (*
 100 let _ =
 101   let e = Sub [Value Sql.Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Sql.Type.Int);] in
 102   e >> get_params >> to_string >> print_endline
 103 *)
 104
 105 let params_of_column tables = function
 106   | All | AllOf _ -> []
 107   | Expr (e,_) -> get_params tables e
 108
 109 let params_of_columns tables = collect (params_of_column tables)
 110
 111 let get_params_opt tables = function
 112   | Some x -> get_params tables x
 113   | None -> []
 114
 115 let get_params_l tables l = collect (get_params tables) l
 116