Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[feature] compiler, database, postgres: Generates postgres dbset

  • Loading branch information...
commit 71f9c7577cfec59ead1d859bbb79336541d4e5d4 1 parent b531eea
Quentin Bourgerie BourgerieQuentin authored
Showing with 38 additions and 5 deletions.
  1. +38 −5 compiler/opa/pass_PostgresCodeGeneration.ml
43 compiler/opa/pass_PostgresCodeGeneration.ml
View
@@ -114,14 +114,47 @@ struct
{env with annotmap; prepared}
let execute_statement
- ({annotmap; prepared; _} as env)
- query =
+ ({gamma; annotmap; prepared; _} as env)
+ node query =
let qid, _ = try QueryMap.find query prepared with
Not_found -> OManager.i_error "Can't found prepared statement"
in
+ let annotmap, database =
+ C.ident annotmap node.S.database.S.ident node.S.database.S.dbty in
let annotmap, qid = C.string annotmap qid in
- {env with annotmap}, qid
-
+ let annotmap, args = (* see type Pack.u *)
+ QmlAstWalk.DbWalk.Query.fold
+ (fun ((annotmap, args) as acc) -> function
+ | QD.QEq (`expr e)
+ | QD.QGt (`expr e)
+ | QD.QLt (`expr e)
+ | QD.QGte (`expr e)
+ | QD.QLte (`expr e)
+ | QD.QNe (`expr e)
+ | QD.QIn (`expr e) ->
+ let ty = QmlAnnotMap.find_ty (Annot.annot (Q.Label.expr e)) annotmap in
+ begin match QmlTypesUtils.Inspect.follow_alias_noopt_private gamma ty with
+ | Q.TypeConst c ->
+ let fld = match c with
+ | Q.TyNull -> assert false
+ | Q.TyFloat -> "Float"
+ | Q.TyInt -> "Int"
+ | Q.TyString -> "Cstring"
+ in
+ let annotmap, arg = C.record annotmap [fld, e] in
+ annotmap, arg::args
+ | ty -> OManager.i_error "expression of type @{<bright>%a@} in sql query are not yet implemented or unexpected" QmlPrint.pp#ty ty
+ end
+ | _ -> acc
+ ) (annotmap, []) (fst query).QD.sql_ops
+ in
+ let annotmap, args = C.list (annotmap, gamma) args in
+ let annotmap, build =
+ OpaMapToIdent.typed_val ~label ~ty:[node.S.ty]
+ Api.Db.build_dbset annotmap gamma
+ in
+ let annotmap, dbset = C.apply gamma annotmap build [database; qid; args] in
+ {env with annotmap}, dbset
let path ~context
({schema; _} as env)
@@ -134,7 +167,7 @@ struct
match node.S.kind with
| S.SqlAccess query ->
let env = prepared_statement env query in
- execute_statement env query
+ execute_statement env node query
| _ -> assert false
end
| _ -> env, Q.Path (label, dbpath, kind, select)
Please sign in to comment.
Something went wrong with that request. Please try again.