postgres wip

MLstate · Jan 23, 2013 · d7ab153 · d7ab153
1 parent 2ad412d
commit d7ab153
Show file tree

Hide file tree

Showing 5 changed files with 39 additions and 15 deletions.
diff --git a/compiler/opa/pass_PostgresCodeGeneration.ml b/compiler/opa/pass_PostgresCodeGeneration.ml
@@ -153,9 +153,9 @@ struct
     | Some (`foreign _) -> assert false
     | Some (`type_ (name,_)) -> Format.pp_print_string fmt name
     | None ->
-        match ty with
+        match QmlTypesUtils.Inspect.follow_alias_noopt_private env.gamma ty with
         | Q.TypeConst Q.TyFloat  -> Format.fprintf fmt "FLOAT8"
-        | Q.TypeConst Q.TyInt    -> Format.fprintf fmt "INT"
+        | Q.TypeConst Q.TyInt    -> Format.fprintf fmt "INT8"
         | Q.TypeConst Q.TyString -> Format.fprintf fmt "TEXT"
         | _ ->
             Format.eprintf "Not_found path [%a]:%a\n%!"
@@ -250,7 +250,7 @@ struct
 
   let execute_statement
       ({gamma; annotmap; q_prepared; _} as env)
-      node query =
+      node (uniq, query) =
     let qid, _ = try QueryMap.find query q_prepared with
         Not_found -> OManager.i_error "Can't found prepared statement"
     in
@@ -280,9 +280,10 @@ struct
             ) (annotmap, []) sql_ops
     in
     let annotmap, args = C.rev_list (annotmap, gamma) args in
+    let build = if uniq then Api.Db.build_uniq else Api.Db.build_dbset in
     let annotmap, build =
       OpaMapToIdent.typed_val ~label ~ty:[node.S.ty]
-        Api.Db.build_dbset annotmap gamma
+        build annotmap gamma
     in
     let annotmap, dbset = C.apply gamma annotmap build [database; qid; args] in
     {env with annotmap}, dbset
@@ -488,9 +489,10 @@ struct
     in
     {QD. sql_ops = Option.map aux query; sql_tbs = [tbl]; sql_fds = []}
 
-  let resolve_sqlaccess env node query =
+  let resolve_sqlaccess env node (uniq, query) =
+    (* TODO  - Prepare for uniq ? *)
     let env = prepared_statement_for_query env query in
-    execute_statement env node query
+    execute_statement env node (uniq, query)
 
   let path ~context
       ({gamma; schema; _} as env)
@@ -502,17 +504,16 @@ struct
         begin
           match kind, node.S.kind with
           | QD.Default, S.SqlAccess query ->
-              resolve_sqlaccess env node query
+              resolve_sqlaccess env node (false, query)
           | QD.Default, S.SetAccess (S.DbSet _, [tbl], query, _) ->
-              let query =
+              let uniq, query =
                 match query with
                 | None ->
-                    (query_to_sqlquery tbl None, QD.default_query_options)
-                | Some (false, (q, o)) ->
-                    (query_to_sqlquery tbl (Some q), o)
-                | _ -> assert false
+                    false, (query_to_sqlquery tbl None, QD.default_query_options)
+                | Some (uniq, (q, o)) ->
+                    uniq, (query_to_sqlquery tbl (Some q), o)
               in
-              resolve_sqlaccess env node query
+              resolve_sqlaccess env node (uniq, query)
           | QD.Update (upd, opt), S.SetAccess (S.DbSet _, [tbl], query, _) ->
               let query =
                 match query with

diff --git a/compiler/opacapi/opacapi.ml b/compiler/opacapi/opacapi.ml
@@ -179,6 +179,7 @@ struct
   let (!!) s = !! ("DbPostgres_" ^ s)
   let open_ = !! "open"
   let build_dbset = !! "build_dbset"
+  let build_uniq = !! "build_uniq"
   let update_or_insert = !! "update_or_insert"
 end
 

diff --git a/lib/stdlib/apis/postgres/pg.opa b/lib/stdlib/apis/postgres/pg.opa
@@ -185,7 +185,10 @@ Pg = {{
       {List=([{Short=0; signed=false; le=false}],List.map(((s) -> [{Short=s; signed=false; le=false}]),codes)); size={S}; le=false},
       {List=([{Binary=Binary.create(0); size={L}}],List.map(((b) -> [{Binary=b; size={L}}]),parameters)); size={S}; le=false},{List=([{Short=0; le=false}],List.map(((s) -> [{Short=s; le=false}]),result_column_codes)); size={S}; le=false}]
     do ServerReference.set(length,[{Long=Pack.Encode.packlen(data)-1; le=false}])
-    do jlog("Bind {data}")
+    do jlog("{data}")
+  do jlog(Binary.to_hex(Outcome.get(Pack.Encode.pack([{List=([{Binary=Binary.create(0); size={L}}],List.map(((b) -> [{Binary=b; size={L}}]),parameters)); size={S}; le=false}]))))
+    do jlog(Binary.to_hex(Outcome.get(Pack.Encode.pack(data))))
+    do List.iter(x -> jlog("Bind {Binary.to_hex(x)}"), parameters)
     data
 
   /** Parser for GSSContinue Authentication submessage

diff --git a/lib/stdlib/apis/postgres/postgres.opa b/lib/stdlib/apis/postgres/postgres.opa
@@ -456,7 +456,6 @@ Postgres = {{
         | {some=failure} -> {failure=(conn,failure)}
         | {none} -> {success=conn}}
     x = Pg.reply({success=conn.conn})
-    do jlog("{x}")
     match x with
     | {success=(c,{Authentication={Ok}})} ->
       loop({conn with conn=c}, acc, f)

diff --git a/lib/stdlib/database/postgres/db.opa b/lib/stdlib/database/postgres/db.opa
@@ -207,6 +207,25 @@ query: {query}
     DbSet.build(iter, void)
   }
 
+  /**
+   * As [build_dbset] but for queries which returns only one value.
+   * @param db The postgres database to request.
+   * @param name Name of the prepared statement.
+   * @param args Arguments of prepared statement, a list of pre-packed values.
+   * @return A value.
+   */
+  function 'a build_uniq(DbPostgres.t db, name, list(Postgres.data) args){
+    match(Iter.to_list(DbSet.iterator(build_dbset(db, name, args)))){
+    case [] :
+      Log.error(@wait(db), "TODO(default): No value was returned by postgres")
+      @fail
+    case [v]: v
+    case [t|_]:
+      Log.error(@wait(db), "Multiple value was returned while expecting strictly one")
+      t
+    }
+  }
+
   function void update_or_insert(DbPostgres.t db, string procname, list(Postgres.data) args){
     c = @wait(db)
     args = List.map(PostgresTypes.string_of_field_value, args)
@@ -221,6 +240,7 @@ query: {query}
 
 @opacapi DbPostgres_open = DbPostgres.open
 @opacapi DbPostgres_build_dbset = DbPostgres.build_dbset
+@opacapi DbPostgres_build_uniq = DbPostgres.build_uniq
 @opacapi DbPostgres_update_or_insert = DbPostgres.update_or_insert