execute-statement is now a word not a generic

sqlite works for tuple-tests
postgresql create/drop/insert works better now

extra/db/db.factor

@@ -36,13 +36,17 @@ HOOK: <prepared-statement> db ( str -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
 GENERIC: reset-statement ( statement -- )
-GENERIC: execute-statement* ( statement -- result-set )
+GENERIC: insert-statement ( statement -- id )
 HOOK: last-id db ( res -- id )
-: execute-statement ( statement -- )
-    execute-statement* dispose ;
 
-: execute-statement-last-id ( statement -- id )
+TUPLE: result-set sql params handle n max ;
-    execute-statement* [ last-id ] with-disposal ;
+GENERIC: query-results ( query -- result-set )
+GENERIC: #rows ( result-set -- n )
+GENERIC: #columns ( result-set -- n )
+GENERIC# row-column 1 ( result-set n -- obj )
+GENERIC: advance-row ( result-set -- ? )
+
+: execute-statement ( statement -- ) query-results dispose ;
 
 : bind-statement ( obj statement -- )
     dup statement-bound? [ dup reset-statement ] when
@@ -50,14 +54,6 @@ HOOK: last-id db ( res -- id )
     [ set-statement-params ] keep
     t swap set-statement-bound? ;
 
-TUPLE: result-set sql params handle n max ;
-
-GENERIC: query-results ( query -- result-set )
-GENERIC: #rows ( result-set -- n )
-GENERIC: #columns ( result-set -- n )
-GENERIC# row-column 1 ( result-set n -- obj )
-GENERIC: advance-row ( result-set -- ? )
-
 : init-result-set ( result-set -- )
     dup #rows over set-result-set-max
     -1 swap set-result-set-n ;

extra/db/postgresql/lib/lib.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays continuations db io kernel math namespaces
-quotations sequences db.postgresql.ffi alien alien.c-types ;
+quotations sequences db.postgresql.ffi alien alien.c-types
+db.types ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -37,13 +38,9 @@ IN: db.postgresql.lib
     >r db get db-handle r>
     [ statement-sql ] keep
     [ statement-params length f ] keep
-    statement-params [ second malloc-char-string ] map >c-void*-array
+    statement-params
+    [ first 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 ;
-
-: pq-oid-value ( res -- n )
-    PQoidValue dup InvalidOid = [
-        "postgresql returned an InvalidOid" throw
-    ] when ;

extra/db/postgresql/postgresql-tests.factor

@@ -2,7 +2,7 @@
 ! Set username and password in  the 'connect' word.
 
 USING: kernel db.postgresql alien continuations io prettyprint
-sequences namespaces tools.test db ;
+sequences namespaces tools.test db db.types ;
 IN: temporary
 
 IN: scratchpad
@@ -40,13 +40,13 @@ IN: temporary
     test-db [
         "select * from person where name = $1 and country = $2"
         <simple-statement> [
-            { "Jane" "New Zealand" }
+            { { "Jane" TEXT } { "New Zealand" TEXT } }
             over do-bound-query
 
             { { "Jane" "New Zealand" } } =
             [ "test fails" throw ] unless
 
-            { "John" "America" }
+            { { "John" TEXT } { "America" TEXT } }
             swap do-bound-query
         ] with-disposal
     ] with-db

extra/db/postgresql/postgresql.factor

@@ -3,7 +3,7 @@
 USING: arrays assocs alien alien.syntax continuations io
 kernel math math.parser namespaces prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
-db.tuples db.types ;
+db.tuples db.types tools.annotations ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -52,8 +52,11 @@ M: postgresql-result-set #columns ( result-set -- n )
 M: postgresql-result-set row-column ( result-set n -- obj )
     >r dup result-set-handle swap result-set-n r> PQgetvalue ;
 
-M: postgresql-statement execute-statement* ( statement -- obj )
+M: postgresql-statement execute-statement ( statement -- obj )
-    query-results ;
+    query-results dispose ;
+
+M: postgresql-statement insert-statement ( statement -- id )
+    query-results dispose ;
 
 : increment-n ( result-set -- n )
     dup result-set-n 1+ dup rot set-result-set-n ;
@@ -105,72 +108,137 @@ M: postgresql-db commit-transaction ( -- )
 M: postgresql-db rollback-transaction ( -- )
     "ROLLBACK" sql-command ;
 
+SYMBOL: postgresql-counter
+
+: make-postgresql-counter ( quot -- )
+    [ postgresql-counter off ] swap compose "" make ;
+
+: counter% ( -- )
+    CHAR: $ ,
+    postgresql-counter [ inc ] keep get # ;
+
+: postgresql-type-hash* ( -- assoc )
+    H{
+        { SERIAL "serial" }
+    } ;
+
+: postgresql-type-hash ( -- assoc )
+    H{
+        { INTEGER "integer" }
+        { SERIAL "integer" }
+        { TEXT "text" }
+        { VARCHAR "varchar" }
+        { DOUBLE "real" }
+    } ;
+
+: enquote ( str -- newstr ) "(" swap ")" 3append ;
+
+: postgresql-type ( str n/str  -- newstr )
+    " " swap number>string* enquote 3append ;
+
+: >sql-type* ( obj -- str )
+    dup pair? [
+        first2 >r >sql-type* r> postgresql-type
+    ] [
+        dup postgresql-type-hash* at* [
+            nip
+        ] [
+            drop >sql-type
+        ] if
+    ] if ;
+
+M: postgresql-db >sql-type ( hash obj -- str )
+    dup pair? [
+        first2 >r >sql-type r> postgresql-type
+    ]  [
+        postgresql-type-hash at* [
+            no-sql-type
+        ] unless
+    ] if ;
 
 M: postgresql-db create-sql ( columns table -- sql )
     [
+        2dup
         "create table " % %
         " (" % [ ", " % ] [
             dup second % " " %
-            dup third >sql-type % " " %
+            dup third >sql-type* % " " %
             sql-modifiers " " join %
-        ] interleave ")" %
+        ] interleave "); " %
-    ] "" make ;
 
-M: postgresql-db drop-sql ( table -- sql )
+        "create function add_" % dup %
-    [
+        "(" %
-        "drop table " % %
+        over [ "," % ]
-    ] "" make ;
+        [ third dup array? [ first ] when >sql-type % ] interleave
+        ")" %
+        " returns bigint as '" %
 
-SYMBOL: postgresql-counter
+        2dup "insert into " %
-
-M: postgresql-db insert-sql* ( columns table -- sql )
-    [
-        postgresql-counter off
-        "insert into " %
         %
         "(" %
         dup [ ", " % ] [ second % ] interleave
         ") " %
         " values (" %
-        [ ", " % ] [
+        [ ", " % ] [ drop counter% ] interleave
-            drop "$" % postgresql-counter [ inc ] keep get #
+        "); " %
-        ] interleave
+
+        "select currval(''" % % "_id_seq'');' language sql;" %
+        drop
+    ] make-postgresql-counter dup . ;
+
+M: postgresql-db drop-sql ( columns table -- sql )
+    [
+        dup "drop table " % %
+        "; drop function add_" % %
+        "(" %
+        [ "," % ] [ third >sql-type % ] interleave
         ")" %
+        
     ] "" make ;
 
+! \ create-sql reset
+! \ create-sql watch
+
+M: postgresql-db insert-sql* ( columns table -- sql )
+    [
+        "select add_" % %
+        "(" %
+        [ ", " % ] [ counter% ] interleave
+        ")" %
+    ] make-postgresql-counter ;
+
 M: postgresql-db update-sql* ( columns table -- sql )
     [
         "update " %
         %
         " set " %
         dup remove-id
-        [ ", " % ] [ second dup % " = :" % % ] interleave
+        [ ", " % ] [ second % " = " % counter% ] interleave
         " where " %
-        [ primary-key? ] find nip second dup % " = :" % %
+        [ primary-key? ] find nip second dup % " = " % counter%
-    ] "" make ;
+    ] make-postgresql-counter ;
 
 M: postgresql-db delete-sql* ( columns table -- sql )
     [
         "delete from " %
         %
         " where " %
-        first second dup % " = :" % %
+        first second dup % " = " % counter%
-    ] "" make ;
+    ] make-postgresql-counter ;
 
 M: postgresql-db select-sql* ( columns table -- sql )
     drop ;
 
 M: postgresql-db tuple>params ( columns tuple -- obj )
-    [
+    [ >r dup third swap first r> get-slot-named swap ]
-        >r dup first r> get-slot-named swap third
+    curry { } map>assoc ;
-    ] curry { } map>assoc ;
     
 M: postgresql-db last-id ( res -- id )
-    pq-oid-value ;
+    drop f ;
 
 : postgresql-db-modifiers ( -- hashtable )
     H{
-        { +native-id+ "primary key" }
+        { +native-id+ "not null primary key" }
         { +assigned-id+ "primary key" }
         { +autoincrement+ "autoincrement" }
         { +unique+ "unique" }
@@ -189,18 +257,3 @@ M: postgresql-db sql-modifiers* ( modifiers -- str )
             swap at
         ] if
     ] with map [ ] subset ;
-
-: postgresql-type-hash ( -- assoc )
-    H{
-        { INTEGER "integer" }
-        { TEXT "text" }
-        { VARCHAR "text" }
-        { DOUBLE "real" }
-    } ;
-
-M: postgresql-db >sql-type ( obj -- str )
-    dup pair? [
-        first >sql-type
-    ] [
-        postgresql-type-hash at* [ T{ no-sql-type } throw ] unless
-    ] if ;

extra/db/sqlite/lib/lib.factor

@@ -74,10 +74,11 @@ IN: db.sqlite.lib
     dup array? [ first ] when
     {
         { INTEGER [ sqlite-bind-int-by-name ] }
-        { BIG_INTEGER [ sqlite-bind-int-by-name ] }
+        { BIG_INTEGER [ sqlite-bind-int64-by-name ] }
         { TEXT [ sqlite-bind-text-by-name ] }
         { VARCHAR [ sqlite-bind-text-by-name ] }
         { DOUBLE [ sqlite-bind-double-by-name ] }
+        { SERIAL [ sqlite-bind-int-by-name ] }
         ! { NULL [ sqlite-bind-null-by-name ] }
         [ no-sql-type ]
     } case ;

extra/db/sqlite/sqlite.factor

@@ -58,8 +58,8 @@ M: sqlite-statement bind-statement* ( triples statement -- )
 M: sqlite-statement reset-statement ( statement -- )
     statement-handle sqlite-reset ;
 
-M: sqlite-statement execute-statement* ( statement -- obj )
+M: sqlite-statement insert-statement ( statement -- id )
-    query-results ;
+    query-results [ last-id ] with-disposal ;
 
 M: sqlite-result-set #columns ( result-set -- n )
     result-set-handle sqlite-#columns ;
@@ -93,9 +93,10 @@ M: sqlite-db create-sql ( columns table -- sql )
         ] interleave ")" %
     ] "" make ;
 
-M: sqlite-db drop-sql ( table -- sql )
+M: sqlite-db drop-sql ( columns table -- sql )
     [
         "drop table " % %
+        drop
     ] "" make ;
 
 M: sqlite-db insert-sql* ( columns table -- sql )
@@ -175,6 +176,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
 : sqlite-type-hash ( -- assoc )
     H{
         { INTEGER "integer" }
+        { SERIAL "integer" }
         { TEXT "text" }
         { VARCHAR "text" }
         { DOUBLE "real" }
@@ -190,4 +192,3 @@ M: sqlite-db >sql-type ( obj -- str )
 ! HOOK: get-column-value ( n result-set type -- )
 ! M: sqlite get-column-value { { "TEXT" get-text-column } { 
 ! "INTEGER" get-integer-column } ... } case ;
-

extra/db/tuples/tuples-tests.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files kernel tools.test db db.sqlite db.tuples
-db.types continuations namespaces db.postgresql math
+db.types continuations namespaces db.postgresql math ;
-tools.time ;
+! tools.time ;
 IN: temporary
 
 TUPLE: person the-id the-name the-number real ;
@@ -44,7 +44,7 @@ SYMBOL: the-person
 
 person "PERSON"
 {
-    { "the-id" "ROWID" INTEGER +native-id+ }
+    { "the-id" "ID" SERIAL +native-id+ }
     { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
     { "the-number" "AGE" INTEGER { +default+ 0 } }
     { "real" "REAL" DOUBLE { +default+ 0.3 } }
@@ -52,12 +52,12 @@ person "PERSON"
 
 "billy" 10 3.14 <person> the-person set
 
-test-sqlite
+ test-sqlite
 ! test-postgresql
 
 person "PERSON"
 {
-    { "the-id" "ROWID" INTEGER +assigned-id+ }
+    { "the-id" "ID" INTEGER +assigned-id+ }
     { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
     { "the-number" "AGE" INTEGER { +default+ 0 } }
     { "real" "REAL" DOUBLE { +default+ 0.3 } }
@@ -65,5 +65,5 @@ person "PERSON"
 
 1 "billy" 20 6.28 <assigned-person> the-person set
 
-test-sqlite
+ test-sqlite
 ! test-postgresql

extra/db/tuples/tuples.factor

@@ -39,7 +39,7 @@ TUPLE: no-slot-named ;
     [ <prepared-statement> ] 3compose cache nip ; inline
 
 HOOK: create-sql db ( columns table -- sql )
-HOOK: drop-sql db ( table -- sql )
+HOOK: drop-sql db ( columns table -- sql )
 HOOK: insert-sql* db ( columns table -- sql )
 HOOK: update-sql* db ( columns table -- sql )
 HOOK: delete-sql* db ( columns table -- sql )
@@ -75,12 +75,12 @@ HOOK: tuple>params db ( columns tuple -- obj )
     dup db-columns swap db-table create-sql sql-command ;
     
 : drop-table ( class -- )
-    db-table drop-sql sql-command ;
+    dup db-columns swap db-table drop-sql sql-command ;
 
 : insert-tuple ( tuple -- )
     [
         [ maybe-remove-id ] [ insert-sql ]
-        make-tuple-statement execute-statement-last-id
+        make-tuple-statement insert-statement
     ] keep set-primary-key ;
 
 : update-tuple ( tuple -- )

extra/db/types/types.factor

@@ -22,6 +22,7 @@ SYMBOL: +not-null+
 
 SYMBOL: +has-many+
 
+SYMBOL: SERIAL
 SYMBOL: INTEGER
 SYMBOL: DOUBLE
 SYMBOL: BOOLEAN