postgresql almost works with blobs

extra/db/postgresql/ffi/ffi.factor

@@ -270,7 +270,8 @@ FUNCTION: char* PQcmdStatus ( PGresult* res ) ;
 FUNCTION: char* PQoidStatus ( PGresult* res ) ;
 FUNCTION: Oid   PQoidValue ( PGresult* res ) ;
 FUNCTION: char* PQcmdTuples ( PGresult* res ) ;
-FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
+! FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
+FUNCTION: void* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
 FUNCTION: int   PQgetlength ( PGresult* res, int tup_num, int field_num ) ;
 FUNCTION: int   PQgetisnull ( PGresult* res, int tup_num, int field_num ) ;
 

extra/db/postgresql/lib/lib.factor

@@ -3,7 +3,7 @@
 USING: arrays continuations db io kernel math namespaces
 quotations sequences db.postgresql.ffi alien alien.c-types
 db.types tools.walker ascii splitting math.parser
-combinators combinators.cleave ;
+combinators combinators.cleave libc shuffle calendar.format ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -44,27 +44,46 @@ IN: db.postgresql.lib
     [ statement-sql ] keep
     [ statement-bind-params length f ] keep
     statement-bind-params
-    [ number>string* malloc-char-string ] map >c-void*-array
-    f f 0 PQexecParams
-    dup postgresql-result-ok? [
-        dup postgresql-result-error-message swap PQclear throw
-    ] unless ;
+    [ number>string* dup [ malloc-char-string ] when ] map
+    [
+        [
+            >c-void*-array f f 0 PQexecParams
+            dup postgresql-result-ok? [
+                dup postgresql-result-error-message swap PQclear throw
+            ] unless
+        ] keep
+    ] [ [ free ] each ] [ ] cleanup ;
+
+: pq-get-string ( handle row column -- obj )
+    3dup PQgetvalue alien>char-string
+    dup "" = [ >r PQgetisnull 1 = f r> ? ] [ 3nip ] if ;
+
+: pq-get-number ( handle row column -- obj )
+    pq-get-string dup [ string>number ] when ;
+
+: pq-get-blob ( handle row column -- obj/f )
+    [ PQgetvalue ] 3keep PQgetlength
+    dup 0 > [
+        memory>byte-array
+    ] [
+        2drop f
+    ] if ;
 
 : postgresql-column-typed ( handle row column type -- obj )
     dup array? [ first ] when
     {
-        { +native-id+ [ ] }
-        { INTEGER [ PQgetvalue string>number ] }
-        { BIG-INTEGER [ PQgetvalue string>number ] }
-        { DOUBLE [ PQgetvalue string>number ] }
-        { TEXT [ PQgetvalue ] }
-        { VARCHAR [ PQgetvalue ] }
-        { DATE [ PQgetvalue ] }
-        { TIME [ PQgetvalue ] }
-        { TIMESTAMP [ PQgetvalue ] }
-        { DATETIME [ PQgetvalue ] }
-        { BLOB [ [ PQgetvalue ] 3keep PQgetlength ] }
-        { FACTOR-BLOB [ [ PQgetvalue ] 3keep PQgetlength ] }
+        { +native-id+ [ pq-get-number ] }
+        { INTEGER [ pq-get-number ] }
+        { BIG-INTEGER [ pq-get-number ] }
+        { DOUBLE [ pq-get-number ] }
+        { TEXT [ pq-get-string ] }
+        { VARCHAR [ pq-get-string ] }
+        { DATE [ pq-get-string dup [ ymd>timestamp ] when ] }
+        { TIME [ pq-get-string dup [ hms>timestamp ] when ] }
+        { TIMESTAMP [ pq-get-string dup [ ymdhms>timestamp ] when ] }
+        { DATETIME [ pq-get-string dup [ ymdhms>timestamp ] when ] }
+        { BLOB [ pq-get-blob ] }
+        { FACTOR-BLOB [ pq-get-blob ] }
         [ no-sql-type ]
     } case ;
-    ! PQgetlength PQgetisnull
+    ! PQgetlength PQgetisnull

extra/db/postgresql/postgresql.factor

@@ -55,7 +55,7 @@ M: postgresql-result-set #columns ( result-set -- n )
     result-set-handle PQnfields ;
 
 M: postgresql-result-set row-column ( result-set column -- obj )
-    >r dup result-set-handle swap result-set-n r> PQgetvalue ;
+    >r dup result-set-handle swap result-set-n r> pq-get-string ;
 
 M: postgresql-result-set row-column-typed ( result-set column -- obj )
     dup pick result-set-out-params nth sql-spec-type
@@ -238,10 +238,13 @@ M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
 
         " from " 0% 0%
         [ sql-spec-slot-name swap get-slot-named ] with subset
-        " where " 0%
-        [ ", " 0% ]
-        [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
-        ";" 0%
+        dup empty? [
+            drop
+        ] [
+            " where " 0%
+            [ " and " 0% ]
+            [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
+        ] if ";" 0%
     ] postgresql-make ;
 
 M: postgresql-db type-table ( -- hash )
@@ -251,7 +254,12 @@ M: postgresql-db type-table ( -- hash )
         { VARCHAR "varchar" }
         { INTEGER "integer" }
         { DOUBLE "real" }
+        { DATE "date" }
+        { TIME "time" }
+        { DATETIME "timestamp" }
         { TIMESTAMP "timestamp" }
+        { BLOB "bytea" }
+        { FACTOR-BLOB "bytea" }
     } ;
 
 M: postgresql-db create-type-table ( -- hash )

extra/db/tuples/tuples-tests.factor

@@ -3,7 +3,7 @@
 USING: io.files kernel tools.test db db.tuples
 db.types continuations namespaces math
 prettyprint tools.walker db.sqlite calendar
-math.intervals ;
+math.intervals db.postgresql ;
 IN: db.tuples.tests
 
 TUPLE: person the-id the-name the-number the-real ts date time blob ;
@@ -161,12 +161,15 @@ TUPLE: annotation n paste-id summary author mode contents ;
 : test-sqlite ( quot -- )
     >r "tuples-test.db" temp-file sqlite-db r> with-db ;
 
-! : test-postgresql ( -- )
-!    >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
+: test-postgresql ( -- )
+>r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
 
 [ native-person-schema test-tuples ] test-sqlite
 [ assigned-person-schema test-tuples ] test-sqlite
 
+[ native-person-schema test-tuples ] test-postgresql
+[ assigned-person-schema test-tuples ] test-postgresql
+
 TUPLE: serialize-me id data ;
 
 : test-serialize ( -- )