start moving db to new-slots

redo the tuple tests so it's a bit easier to work with
fix a bug where selecting based on an empty tuple wouldn't work

extra/db/db.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes continuations kernel math
 namespaces sequences sequences.lib tuples words strings
-tools.walker ;
+tools.walker new-slots accessors ;
 IN: db
 
 TUPLE: db
@@ -25,10 +25,10 @@ HOOK: db-close db ( handle -- )
 
 : dispose-db ( db -- ) 
     dup db [
-        dup db-insert-statements dispose-statements
+        dup insert-statements>> dispose-statements
-        dup db-update-statements dispose-statements
+        dup update-statements>> dispose-statements
-        dup db-delete-statements dispose-statements
+        dup delete-statements>> dispose-statements
-        db-handle db-close
+        handle>> db-close
     ] with-variable ;
 
 TUPLE: statement handle sql in-params out-params bind-params bound? ;
@@ -36,11 +36,7 @@ TUPLE: simple-statement ;
 TUPLE: prepared-statement ;
 TUPLE: result-set sql params handle n max ;
 : <statement> ( sql in out -- statement )
-    {
+    { (>>sql) (>>in-params) (>>out-params) } statement construct ;
-        set-statement-sql
-        set-statement-in-params
-        set-statement-out-params
-    } statement construct ;
 
 HOOK: <simple-statement> db ( str in out -- statement )
 HOOK: <prepared-statement> db ( str in out -- statement )
@@ -62,21 +58,18 @@ GENERIC: more-rows? ( result-set -- ? )
     ] if ;
 
 : bind-statement ( obj statement -- )
-    [ set-statement-bind-params ] keep
+    swap >>bind-params
     [ bind-statement* ] keep
-    t swap set-statement-bound? ;
+    t >>bound? drop ;
 
 : init-result-set ( result-set -- )
-    dup #rows over set-result-set-max
+    dup #rows >>max
-    0 swap set-result-set-n ;
+    0 >>n drop ;
 
 : <result-set> ( query handle tuple -- result-set )
-    >r >r { statement-sql statement-in-params } get-slots r>
+    >r >r { sql>> in-params>> } get-slots r>
-    {
+    { (>>sql) (>>params) (>>handle) } result-set
-        set-result-set-sql
+    construct r> construct-delegate ;
-        set-result-set-params
-        set-result-set-handle
-    } result-set construct r> construct-delegate ;
 
 : sql-row ( result-set -- seq )
     dup #columns [ row-column ] with map ;

extra/db/sqlite/sqlite.factor

@@ -5,7 +5,7 @@ hashtables io.files kernel math math.parser namespaces
 prettyprint sequences strings tuples alien.c-types
 continuations db.sqlite.lib db.sqlite.ffi db.tuples
 words combinators.lib db.types combinators tools.walker
-combinators.cleave ;
+combinators.cleave io ;
 IN: db.sqlite
 
 TUPLE: sqlite-db path ;
@@ -173,10 +173,14 @@ M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
 
         " from " 0% 0%
         [ sql-spec-slot-name swap get-slot-named ] with subset
-        " where " 0%
+        dup empty? [
-        [ ", " 0% ]
+            drop
-        [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
+        ] [
-        ";" 0%
+            " where " 0%
+            [ ", " 0% ]
+            [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
+            ";" 0%
+        ] if
     ] sqlite-make ;
 
 M: sqlite-db modifier-table ( -- hashtable )

extra/db/tuples/tuples-tests.factor

@@ -41,73 +41,73 @@ SYMBOL: the-person2
             T{ person f 2 "johnny" 10 3.14 }
         }
     ] [ T{ person f f f f 3.14 } select-tuples ] unit-test
+    [
+        {
+            T{ person f 1 "billy" 200 3.14 }
+            T{ person f 2 "johnny" 10 3.14 }
+        }
+    ] [ T{ person f } select-tuples ] unit-test
+
 
     [ ] [ the-person1 get delete-tuple ] unit-test
     [ f ] [ T{ person f 1 } select-tuple ] unit-test
     [ ] [ person drop-table ] unit-test ;
 
-: test-sqlite ( -- )
+: make-native-person-table ( -- )
-    "tuples-test.db" resource-path sqlite-db [
+    [ person drop-table ] [ drop ] recover
-        test-tuples
+    person create-table
-    ] with-db ;
+    T{ person f f "billy" 200 3.14 } insert-tuple
+    T{ person f f "johnny" 10 3.14 } insert-tuple
+    ;
 
-: test-postgresql ( -- )
+: native-person-schema ( -- )
-    { "localhost" "postgres" "" "factor-test" } postgresql-db [
+    person "PERSON"
-        test-tuples
+    {
-    ] with-db ;
+        { "the-id" "ID" +native-id+ }
+        { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+        { "the-number" "AGE" INTEGER { +default+ 0 } }
+        { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+    } define-persistent
+    "billy" 10 3.14 <person> the-person1 set
+    "johnny" 10 3.14 <person> the-person2 set ;
 
-person "PERSON"
+: assigned-person-schema ( -- )
-{
+    person "PERSON"
-    { "the-id" "ID" +native-id+ }
+    {
-    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+        { "the-id" "ID" INTEGER +assigned-id+ }
-    { "the-number" "AGE" INTEGER { +default+ 0 } }
+        { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
-    { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+        { "the-number" "AGE" INTEGER { +default+ 0 } }
-} define-persistent
+        { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+    } define-persistent
+    1 "billy" 10 3.14 <assigned-person> the-person1 set
+    2 "johnny" 10 3.14 <assigned-person> the-person2 set ;
 
-"billy" 10 3.14 <person> the-person1 set
-"johnny" 10 3.14 <person> the-person2 set
-
-test-sqlite
-! test-postgresql
-
-person "PERSON"
-{
-    { "the-id" "ID" INTEGER +assigned-id+ }
-    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
-    { "the-number" "AGE" INTEGER { +default+ 0 } }
-    { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
-} define-persistent
-
-1 "billy" 10 3.14 <assigned-person> the-person1 set
-2 "johnny" 10 3.14 <assigned-person> the-person2 set
-
-test-sqlite
-! test-postgresql
 
 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 TUPLE: annotation n paste-id summary author mode contents ;
 
-paste "PASTE"
+: native-paste-schema ( -- )
-{
+    paste "PASTE"
-    { "n" "ID" +native-id+ }
+    {
-    { "summary" "SUMMARY" TEXT }
+        { "n" "ID" +native-id+ }
-    { "author" "AUTHOR" TEXT }
+        { "summary" "SUMMARY" TEXT }
-    { "channel" "CHANNEL" TEXT }
+        { "author" "AUTHOR" TEXT }
-    { "mode" "MODE" TEXT }
+        { "channel" "CHANNEL" TEXT }
-    { "contents" "CONTENTS" TEXT }
+        { "mode" "MODE" TEXT }
-    { "date" "DATE" TIMESTAMP }
+        { "contents" "CONTENTS" TEXT }
-    { "annotations" { +has-many+ annotation } }
+        { "date" "DATE" TIMESTAMP }
-} define-persistent
+        { "annotations" { +has-many+ annotation } }
+    } define-persistent
 
-annotation "ANNOTATION"
+    annotation "ANNOTATION"
-{
+    {
-    { "n" "ID" +native-id+ }
+        { "n" "ID" +native-id+ }
-    { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
+        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
-    { "summary" "SUMMARY" TEXT }
+        { "summary" "SUMMARY" TEXT }
-    { "author" "AUTHOR" TEXT }
+        { "author" "AUTHOR" TEXT }
-    { "mode" "MODE" TEXT }
+        { "mode" "MODE" TEXT }
-    { "contents" "CONTENTS" TEXT }
+        { "contents" "CONTENTS" TEXT }
-} define-persistent
+    } define-persistent ;
 
 ! { "localhost" "postgres" "" "factor-test" } postgresql-db [
     ! [ paste drop-table ] [ drop ] recover
@@ -117,3 +117,15 @@ annotation "ANNOTATION"
     ! [ ] [ paste create-table ] unit-test
     ! [ ] [ annotation create-table ] unit-test
 ! ] with-db
+
+
+: test-sqlite ( quot -- )
+    >r "tuples-test.db" resource-path sqlite-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
+
+! [ make-native-person-table ] test-sqlite