partial conversion of postgres

extra/db/postgresql/lib/lib.factor

@@ -5,7 +5,7 @@ quotations sequences db.postgresql.ffi alien alien.c-types
 db.types tools.walker ascii splitting math.parser combinators
 libc shuffle calendar.format byte-arrays destructors prettyprint
 accessors strings serialize io.encodings.binary
-io.streams.byte-array ;
+io.streams.byte-array inspector ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -28,7 +28,13 @@ IN: db.postgresql.lib
 : postgresql-error ( res -- res )
     dup [ postgresql-error-message throw ] unless ;
 
-: postgresql-result-ok? ( n -- ? )
+ERROR: postgresql-result-null ;
+
+M: postgresql-result-null summary ( obj -- str )
+    drop "PQexec returned f." ;
+
+: postgresql-result-ok? ( res -- ? )
+    [ postgresql-result-null ] unless*
     PQresultStatus
     PGRES_COMMAND_OK PGRES_TUPLES_OK 2array member? ;
 

extra/db/postgresql/postgresql.factor

@@ -5,7 +5,7 @@ kernel math math.parser namespaces prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
 combinators sequences.lib classes locals words tools.walker
-namespaces.lib accessors ;
+namespaces.lib accessors random ;
 IN: db.postgresql
 
 TUPLE: postgresql-db < db
@@ -43,10 +43,9 @@ M: postgresql-statement bind-statement* ( statement -- )
     drop ;
 
 M: postgresql-statement bind-tuple ( tuple statement -- )
-    [
+    tuck in-params>>
-        statement-in-params
+    [ slot-name>> swap get-slot-named ] with map
-        [ sql-spec-slot-name swap get-slot-named ] with map
+    >>bind-params drop ;
-    ] keep set-statement-bind-params ;
 
 M: postgresql-result-set #rows ( result-set -- n )
     handle>> PQntuples ;
@@ -55,11 +54,11 @@ M: postgresql-result-set #columns ( result-set -- n )
     handle>> PQnfields ;
 
 M: postgresql-result-set row-column ( result-set column -- obj )
-    >r dup result-set-handle swap result-set-n r> pq-get-string ;
+    >r [ handle>> ] [ n>> ] bi 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
-    >r >r [ result-set-handle ] [ result-set-n ] bi r> r> postgresql-column-typed ;
+    >r >r [ handle>> ] [ result-set-n ] bi r> r> postgresql-column-typed ;
 
 M: postgresql-statement query-results ( query -- result-set )
     dup statement-bind-params [
@@ -82,7 +81,7 @@ M: postgresql-statement dispose ( query -- )
     f swap set-statement-handle ;
 
 M: postgresql-result-set dispose ( result-set -- )
-    dup result-set-handle PQclear
+    dup handle>> PQclear
     0 0 f roll {
         set-result-set-n set-result-set-max set-result-set-handle
     } set-slots ;
@@ -90,7 +89,7 @@ M: postgresql-result-set dispose ( result-set -- )
 M: postgresql-statement prepare-statement ( statement -- )
     [
         >r db get handle>> "" r>
-        dup statement-sql swap statement-in-params
+        [ sql>> ] [ in-params>> ] bi
         length f PQprepare postgresql-error
     ] keep set-statement-handle ;
 
@@ -115,7 +114,10 @@ SYMBOL: postgresql-counter
     postgresql-counter [ inc ] keep get 0# ;
 
 M: postgresql-db bind% ( spec -- )
-    1, bind-name% ;
+    bind-name% 1, ;
+
+M: postgresql-db bind# ( spec obj -- )
+    >r bind-name% f swap type>> r> <literal-bind> 1, ;
 
 : postgresql-make ( class quot -- )
     >r sql-props r>
@@ -125,11 +127,10 @@ M: postgresql-db bind% ( spec -- )
 : create-table-sql ( class -- statement )
     [
         "create table " 0% 0%
-        "(" 0%
+        "(" 0% [ ", " 0% ] [
-        [ ", " 0% ] [
+            dup column-name>> 0%
-            dup sql-spec-column-name 0%
             " " 0%
-            dup sql-spec-type t lookup-type 0%
+            dup type>> t lookup-type 0%
             modifiers 0%
         ] interleave ");" 0%
     ] postgresql-make ;
@@ -250,6 +251,7 @@ M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
 M: postgresql-db type-table ( -- hash )
     H{
         { +native-id+ "integer" }
+        { +random-id+ "bigint" }
         { TEXT "text" }
         { VARCHAR "varchar" }
         { INTEGER "integer" }
@@ -265,6 +267,7 @@ M: postgresql-db type-table ( -- hash )
 M: postgresql-db create-type-table ( -- hash )
     H{
         { +native-id+ "serial primary key" }
+        { +random-id+ "bigint primary key" }
     } ;
 
 : postgresql-compound ( str n -- newstr )
@@ -286,12 +289,16 @@ M: postgresql-db modifier-table ( -- hashtable )
     H{
         { +native-id+ "primary key" }
         { +assigned-id+ "primary key" }
+        { +random-id+ "primary key" }
         { +foreign-id+ "references" }
         { +autoincrement+ "autoincrement" }
         { +unique+ "unique" }
         { +default+ "default" }
         { +null+ "null" }
         { +not-null+ "not null" }
+        { system-random-generator "" }
+        { secure-random-generator "" }
+        { random-generator "" }
     } ;
 
 M: postgresql-db compound-type ( str n -- newstr )

extra/db/sqlite/sqlite.factor

@@ -110,10 +110,16 @@ M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ;
 M: sqlite-db commit-transaction ( -- ) "COMMIT" sql-command ;
 M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
 
+
+: maybe-make-retryable ( statement -- statement )
+    dup in-params>> [ generator-bind? ] contains? [
+        make-retryable
+    ] when ;
+
 : sqlite-make ( class quot -- )
     >r sql-props r>
     [ 0 sql-counter rot with-variable ] { "" { } { } } nmake
-    <simple-statement> ;
+    <simple-statement> maybe-make-retryable ;
 
 M: sqlite-db create-sql-statement ( class -- statement )
     [
@@ -124,7 +130,7 @@ M: sqlite-db create-sql-statement ( class -- statement )
             dup type>> t lookup-type 0%
             modifiers 0%
         ] interleave ");" 0%
-    ] sqlite-make ;
+    ] sqlite-make dup sql>> . ;
 
 M: sqlite-db drop-sql-statement ( class -- statement )
     [ "drop table " 0% 0% ";" 0% drop ] sqlite-make ;
@@ -151,10 +157,7 @@ M: sqlite-db <insert-native-statement> ( tuple -- statement )
             ] if
         ] interleave
         ");" 0%
-    ] sqlite-make
+    ] sqlite-make ;
-    dup in-params>> [ generator-bind? ] contains? [
-        make-retryable
-    ] when ;
 
 M: sqlite-db <insert-nonnative-statement> ( tuple -- statement )
     <insert-native-statement> ;

extra/db/tuples/tuples-tests.factor

@@ -346,13 +346,15 @@ C: <secret> secret
     ] unit-test
 
     [ t ] [
-        T{ secret } select-tuples dup . length 3 =
+        T{ secret } select-tuples length 3 =
     ] unit-test ;
 
 [ test-random-id ] test-sqlite
 [ native-person-schema test-tuples ] test-sqlite
 [ assigned-person-schema test-tuples ] test-sqlite
 [ assigned-person-schema test-repeated-insert ] test-sqlite
+
+[ test-random-id ] test-postgresql
 [ native-person-schema test-tuples ] test-postgresql
 [ assigned-person-schema test-tuples ] test-postgresql
 [ assigned-person-schema test-repeated-insert ] test-postgresql

extra/db/types/types.factor

@@ -110,8 +110,7 @@ ERROR: no-sql-type ;
     dup array? [
         first lookup-type*
     ] [
-        type-table at*
+        type-table at* [ no-sql-type ] unless
-        [ no-sql-type ] unless
     ] if ;
 
 : lookup-create-type ( obj -- str )