lose the bad codez in sqlite

change the db api to more-rows? and advance-row instead of just advance-row
sql-command takes a string or a seq of strings
postgresql create-sql handles native/assigned ids

extra/db/db.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes continuations kernel math
-namespaces sequences sequences.lib tuples words ;
+namespaces sequences sequences.lib tuples words strings ;
 IN: db
 
 TUPLE: db handle insert-statements update-statements delete-statements select-statements ;
@@ -37,14 +37,14 @@ GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
 GENERIC: reset-statement ( statement -- )
 GENERIC: insert-statement ( statement -- id )
-HOOK: last-id db ( res -- id )
 
 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 -- ? )
+GENERIC: advance-row ( result-set -- )
+GENERIC: more-rows? ( result-set -- ? )
 
 : execute-statement ( statement -- ) query-results dispose ;
 
@@ -56,7 +56,7 @@ GENERIC: advance-row ( result-set -- ? )
 
 : init-result-set ( result-set -- )
     dup #rows over set-result-set-max
-    -1 swap set-result-set-n ;
+    0 swap set-result-set-n ;
 
 : <result-set> ( query handle tuple -- result-set )
     >r >r { statement-sql statement-params } get-slots r>
@@ -70,10 +70,10 @@ GENERIC: advance-row ( result-set -- ? )
     dup #columns [ row-column ] with map ;
 
 : query-each ( statement quot -- )
-    over advance-row [
+    over more-rows? [
-        2drop
+        [ call ] 2keep over advance-row query-each
     ] [
-        [ call ] 2keep query-each
+        2drop
     ] if ; inline
 
 : query-map ( statement quot -- seq )
@@ -94,11 +94,6 @@ GENERIC: advance-row ( result-set -- ? )
 : do-bound-command ( obj query -- )
     [ bind-statement ] keep execute-statement ;
 
-: sql-query ( sql -- rows )
-    <simple-statement> [ do-query ] with-disposal ;
-
-: sql-command ( sql -- )
-    <simple-statement> [ execute-statement ] with-disposal ;
 
 SYMBOL: in-transaction
 HOOK: begin-transaction db ( -- )
@@ -112,3 +107,13 @@ HOOK: rollback-transaction db ( -- )
         begin-transaction
         [ ] [ rollback-transaction ] cleanup commit-transaction
     ] with-variable ;
+
+: sql-query ( sql -- rows )
+    <simple-statement> [ do-query ] with-disposal ;
+
+: sql-command ( sql -- )
+    dup string? [
+        <simple-statement> [ execute-statement ] with-disposal
+    ] [
+        [ [ sql-command ] each ] with-transaction
+    ] if ;

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 tools.annotations ;
+db.tuples db.types tools.annotations math.ranges ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -52,14 +52,8 @@ 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 )
-    query-results dispose ;
-
 M: postgresql-statement insert-statement ( statement -- id )
-    query-results dispose ;
+    query-results [ break 0 row-column ] with-disposal ;
-
-: increment-n ( result-set -- n )
-    dup result-set-n 1+ dup rot set-result-set-n ;
 
 M: postgresql-statement query-results ( query -- result-set )
     dup statement-params [
@@ -71,8 +65,11 @@ M: postgresql-statement query-results ( query -- result-set )
     postgresql-result-set <result-set>
     dup init-result-set ;
 
-M: postgresql-result-set advance-row ( result-set -- ? )
+M: postgresql-result-set advance-row ( result-set -- )
-    dup increment-n swap result-set-max >= ;
+    dup result-set-n 1+ swap set-result-set-n ;
+
+M: postgresql-result-set more-rows? ( result-set -- ? )
+    dup result-set-n swap result-set-max < ;
 
 M: postgresql-statement dispose ( query -- )
     dup statement-handle PQclear
@@ -108,15 +105,6 @@ 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" }
@@ -156,16 +144,9 @@ M: postgresql-db >sql-type ( hash obj -- str )
         ] unless
     ] if ;
 
-M: postgresql-db create-sql ( columns table -- sql )
+: insert-function ( columns table -- sql )
     [
-        2dup
+        >r remove-id r>
-        "create table " % %
-        " (" % [ ", " % ] [
-            dup second % " " %
-            dup third >sql-type* % " " %
-            sql-modifiers " " join %
-        ] interleave "); " %
-
         "create function add_" % dup %
         "(" %
         over [ "," % ]
@@ -179,33 +160,52 @@ M: postgresql-db create-sql ( columns table -- sql )
         dup [ ", " % ] [ second % ] interleave
         ") " %
         " values (" %
-        [ ", " % ] [ drop counter% ] interleave
+        length [1,b] [ ", " % ] [ "$" % # ] interleave
         "); " %
 
         "select currval(''" % % "_id_seq'');' language sql;" %
         drop
-    ] make-postgresql-counter dup . ;
+    ] "" make ;
 
-M: postgresql-db drop-sql ( columns table -- sql )
+: drop-function ( columns table -- sql )
     [
-        dup "drop table " % %
+        >r remove-id r>
-        "; drop function add_" % %
+        "drop function add_" % %
         "(" %
         [ "," % ] [ third >sql-type % ] interleave
         ")" %
-        
     ] "" make ;
 
-! \ create-sql reset
+M: postgresql-db create-sql ( columns table -- seq )
-! \ create-sql watch
+    [
+        [
+            2dup
+            "create table " % %
+            " (" % [ ", " % ] [
+                dup second % " " %
+                dup third >sql-type* % " " %
+                sql-modifiers " " join %
+            ] interleave "); " %
+        ] "" make ,
+
+        over native-id? [ insert-function , ] [ 2drop ] if
+    ] { } make ;
+
+M: postgresql-db drop-sql ( columns table -- seq )
+    [
+        [
+            dup "drop table " % % ";" %
+        ] "" make ,
+        over native-id? [ drop-function , ] [ 2drop ] if
+    ] { } make ;
 
 M: postgresql-db insert-sql* ( columns table -- sql )
     [
         "select add_" % %
         "(" %
-        [ ", " % ] [ counter% ] interleave
+        length [1,b] [ ", " % ] [ "$" % # ] interleave
         ")" %
-    ] make-postgresql-counter ;
+    ] "" make ;
 
 M: postgresql-db update-sql* ( columns table -- sql )
     [
@@ -213,18 +213,19 @@ M: postgresql-db update-sql* ( columns table -- sql )
         %
         " set " %
         dup remove-id
-        [ ", " % ] [ second % " = " % counter% ] interleave
+        dup length [1,b] swap 2array flip
+        [ ", " % ] [ first2 second % " = $" % # ] interleave
         " where " %
-        [ primary-key? ] find nip second dup % " = " % counter%
+        [ primary-key? ] find nip second dup % " = $" % length 2 + #
-    ] make-postgresql-counter ;
+    ] "" make ;
 
 M: postgresql-db delete-sql* ( columns table -- sql )
     [
         "delete from " %
         %
         " where " %
-        first second dup % " = " % counter%
+        first second % " = $1" %
-    ] make-postgresql-counter ;
+    ] "" make ;
 
 M: postgresql-db select-sql* ( columns table -- sql )
     drop ;

extra/db/sqlite/lib/lib.factor

@@ -100,13 +100,13 @@ IN: db.sqlite.lib
 : sqlite-row ( handle -- seq )
     dup sqlite-#columns [ sqlite-column ] with map ;
 
-: step-complete? ( step-result -- bool )
+: sqlite-step-has-more-rows? ( step-result -- bool )
     dup SQLITE_ROW =  [
-        drop f
+        drop t
     ] [
         dup SQLITE_DONE =
-        [ drop ] [ sqlite-check-result ] if t
+        [ drop ] [ sqlite-check-result ] if f
     ] if ;
 
 : sqlite-next ( prepared -- ? )
-    sqlite3_step step-complete? ;
+    sqlite3_step sqlite-step-has-more-rows? ;

extra/db/sqlite/sqlite.factor

@@ -25,9 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ;
 TUPLE: sqlite-statement ;
 C: <sqlite-statement> sqlite-statement
 
-TUPLE: sqlite-result-set advanced? ;
+TUPLE: sqlite-result-set has-more? ;
-: <sqlite-result-set> ( query -- sqlite-result-set )
-    dup statement-handle sqlite-result-set <result-set> ;
 
 M: sqlite-db <simple-statement> ( str -- obj )
     <prepared-statement> ;
@@ -40,13 +38,7 @@ M: sqlite-db <prepared-statement> ( str -- obj )
 M: sqlite-statement dispose ( statement -- )
     statement-handle sqlite-finalize ;
 
-: maybe-advance-row ( result-set -- result-set )
-    dup sqlite-result-set-advanced? [
-        dup advance-row drop
-    ] unless ;
-
 M: sqlite-result-set dispose ( result-set -- )
-    maybe-advance-row
     f swap set-result-set-handle ;
 
 : sqlite-bind ( triples handle -- )
@@ -58,8 +50,12 @@ M: sqlite-statement bind-statement* ( triples statement -- )
 M: sqlite-statement reset-statement ( statement -- )
     statement-handle sqlite-reset ;
 
+: last-insert-id ( -- id )
+    db get db-handle sqlite3_last_insert_rowid
+    dup zero? [ "last-id failed" throw ] when ;
+
 M: sqlite-statement insert-statement ( statement -- id )
-    query-results [ last-id ] with-disposal ;
+    execute-statement last-insert-id ;
 
 M: sqlite-result-set #columns ( result-set -- n )
     result-set-handle sqlite-#columns ;
@@ -67,12 +63,16 @@ M: sqlite-result-set #columns ( result-set -- n )
 M: sqlite-result-set row-column ( result-set n -- obj )
     >r result-set-handle r> sqlite-column ;
 
-M: sqlite-result-set advance-row ( result-set -- handle ? )
+M: sqlite-result-set advance-row ( result-set -- )
     [ result-set-handle sqlite-next ] keep
-    t swap set-sqlite-result-set-advanced? ;
+    set-sqlite-result-set-has-more? ;
+
+M: sqlite-result-set more-rows? ( result-set -- ? )
+    sqlite-result-set-has-more? ;
 
 M: sqlite-statement query-results ( query -- result-set )
-    dup statement-handle sqlite-result-set <result-set> ;
+    dup statement-handle sqlite-result-set <result-set>
+    dup advance-row ;
 
 M: sqlite-db begin-transaction ( -- )
     "BEGIN" sql-command ;
@@ -146,11 +146,6 @@ M: sqlite-db tuple>params ( columns tuple -- obj )
         third 3array
     ] curry map ;
 
-M: sqlite-db last-id ( result-set -- id )
-    maybe-advance-row drop
-    db get db-handle sqlite3_last_insert_rowid
-    dup zero? [ "last-id failed" throw ] when ;
-
 : sqlite-db-modifiers ( -- hashtable )
     H{
         { +native-id+ "primary key" }

extra/db/tuples/tuples-tests.factor

@@ -30,7 +30,8 @@ SYMBOL: the-person
 
     [ ] [ the-person get update-tuple ] unit-test
 
-    [ ] [ the-person get delete-tuple ] unit-test ;
+    [ ] [ the-person get delete-tuple ] unit-test
+    [ ] [ person drop-table ] unit-test ;
 
 : test-sqlite ( -- )
     "tuples-test.db" resource-path <sqlite-db> [
@@ -52,8 +53,8 @@ person "PERSON"
 
 "billy" 10 3.14 <person> the-person set
 
- test-sqlite
+! test-sqlite
-! test-postgresql
+test-postgresql
 
 person "PERSON"
 {
@@ -65,5 +66,5 @@ person "PERSON"
 
 1 "billy" 20 6.28 <assigned-person> the-person set
 
- test-sqlite
+! test-sqlite
 ! test-postgresql

extra/db/tuples/tuples.factor

@@ -38,8 +38,9 @@ TUPLE: no-slot-named ;
     [ db-table dupd ] swap
     [ <prepared-statement> ] 3compose cache nip ; inline
 
-HOOK: create-sql db ( columns table -- sql )
+HOOK: create-sql db ( columns table -- seq )
-HOOK: drop-sql db ( columns table -- sql )
+HOOK: drop-sql db ( columns table -- seq )
+
 HOOK: insert-sql* db ( columns table -- sql )
 HOOK: update-sql* db ( columns table -- sql )
 HOOK: delete-sql* db ( columns table -- sql )

extra/db/types/types.factor

@@ -11,6 +11,12 @@ SYMBOL: +assigned-id+
 : primary-key? ( spec -- ? )
     [ { +native-id+ +assigned-id+ } member? ] contains? ;
 
+: contains-id? ( columns id -- ? )
+    swap [ member? ] with contains? ;
+    
+: assigned-id? ( columns -- ? ) +assigned-id+ contains-id? ;
+: native-id? ( columns -- ? ) +native-id+ contains-id? ;
+
 ! Same concept, SQLite has autoincrement, PostgreSQL has serial
 SYMBOL: +autoincrement+
 SYMBOL: +serial+