syntax.ml

   1 (* SQL syntax and RA *)
   2
   3 open Stmt
   4 open Operators
   5
   6 type expr = | Value of Sql.Type.t
   7             | Param of param
   8             | Sub of expr list
   9             | Column of string * string option (** name, table *)
  10             deriving (Show)
  11
  12 let expr_to_string = Show.show<expr>
  13
  14 type column =
  15   | All
  16   | AllOf of string
  17   | Expr of expr * string option (** name *)
  18   deriving (Show)
  19
  20 type columns = column list deriving (Show)
  21
  22 let collect f l = List.flatten (List.map f l)
  23
  24 let get_scheme columns tables =
  25   let all = tables >> List.map snd >> List.flatten in
  26   let scheme name = name >> Tables.get_from tables >> snd in
  27   let resolve1 = function
  28     | All -> all
  29     | AllOf t -> scheme t
  30     | Expr (e,name) ->
  31       let col =
  32       begin match e with
  33       | Column (name,Some t) -> RA.Scheme.find (scheme t) name
  34       | Column (name,None) -> RA.Scheme.find all name
  35       | _ -> RA.attr "" Sql.Type.Text (* some expression *)
  36       end in
  37       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
  38       [ col ]
  39   in
  40   collect resolve1 columns
  41
  42 let get_params e =
  43   let rec loop acc e =
  44     match e with
  45     | Param p -> p::acc
  46     | Sub l -> List.fold_left loop acc l
  47     | _ -> acc
  48   in loop [] e >> List.rev
  49
  50 (*
  51 let _ =
  52   let e = Sub [Value Sql.Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Sql.Type.Int);] in
  53   e >> get_params >> to_string >> print_endline
  54 *)
  55
  56 let params_of_column = function
  57   | All | AllOf _ -> []
  58   | Expr (e,_) -> get_params e
  59
  60 let params_of_columns = collect params_of_column
  61
  62 let get_params_opt = function
  63   | Some x -> get_params x
  64   | None -> []
  65
  66 let get_params_l = collect get_params
  67
  68 let scheme_as_params = List.map (fun attr -> Named attr.RA.name, Some attr.RA.domain)