fix a couple of minor bugs before major overhaul

extra/db/db.factor

@@ -23,12 +23,12 @@ HOOK: db-close db ( handle -- )
         db-handle db-close
     ] with-variable ;
 
-TUPLE: statement handle sql slot-names bound? in-params out-params ;
+TUPLE: statement handle sql bound? in-params out-params ;
 TUPLE: simple-statement ;
 TUPLE: prepared-statement ;
 
 HOOK: <simple-statement> db ( str -- statement )
-HOOK: <prepared-statement> db ( str slot-names -- statement )
+HOOK: <prepared-statement> db ( str -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
 GENERIC: reset-statement ( statement -- )

extra/db/postgresql/postgresql.factor

@@ -4,7 +4,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 math.ranges
-combinators sequences.lib classes locals words ;
+combinators sequences.lib classes locals words tools.walker ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -65,6 +65,7 @@ M: postgresql-result-set sql-type>factor-type ( obj type -- newobj )
     } case ;
 
 M: postgresql-statement insert-statement ( statement -- id )
+break
     query-results [ 0 row-column ] with-disposal string>number ;
 
 M: postgresql-statement query-results ( query -- result-set )
@@ -104,10 +105,13 @@ M: postgresql-db <simple-statement> ( sql -- statement )
     { set-statement-sql } statement construct
     <postgresql-statement> ;
 
-M: postgresql-db <prepared-statement> ( pair -- statement )
+M: postgresql-db <prepared-statement> ( triple -- statement )
-    ?first2
+    ?first3
-    { set-statement-sql set-statement-slot-names }
+    {
-    statement construct <postgresql-statement> ;
+        set-statement-sql
+        set-statement-in-params
+        set-statement-out-params
+    } statement construct <postgresql-statement> ;
 
 M: postgresql-db begin-transaction ( -- )
     "BEGIN" sql-command ;
@@ -166,6 +170,7 @@ SYMBOL: postgresql-counter
 
 : drop-function-sql ( specs table -- sql )
     [
+break
         "drop function add_" % %
         "(" %
         remove-id
@@ -215,8 +220,8 @@ M: postgresql-db drop-sql ( specs table -- seq )
     ] postgresql-make ;
 
 M: postgresql-db insert-sql* ( specs table -- sql in-specs out-specs )
-    over find-primary-key native-id?
+    dup class db-columns find-primary-key native-id?
-    [ insert-function-sql ] [ insert-table-sql ] if ;
+    [ insert-function-sql ] [ insert-table-sql ] if 3array ;
 
 M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs )
     [
@@ -228,7 +233,7 @@ M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs )
         " where " 0%
         find-primary-key
         dup sql-spec-column-name 0% " = " 0% bind%
-    ] postgresql-make ;
+    ] postgresql-make 3array ;
 
 M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
     [
@@ -236,7 +241,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
         " where " 0%
         find-primary-key
         dup sql-spec-column-name 0% " = " 0% bind%
-    ] postgresql-make ;
+    ] postgresql-make 3array ;
 
 : select-by-slots-sql ( tuple -- sql in-specs out-specs )
     [
@@ -251,7 +256,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
         [ ", " 0% ]
         [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
         ";" 0%
-    ] postgresql-make ;
+    ] postgresql-make 3array ;
 
 ! : select-with-relations ( tuple -- sql in-specs out-specs )
 
@@ -259,7 +264,7 @@ M: postgresql-db select-sql ( tuple -- sql in-specs out-specs )
     select-by-slots-sql ;
 
 M: postgresql-db tuple>params ( specs tuple -- obj )
-    [ >r dup third swap first r> get-slot-named swap ]
+    [ >r dup sql-spec-type swap sql-spec-slot-name r> get-slot-named swap ]
     curry { } map>assoc ;
 
 M: postgresql-db type-table ( -- hash )
@@ -268,6 +273,7 @@ M: postgresql-db type-table ( -- hash )
         { TEXT "text" }
         { VARCHAR "varchar" }
         { INTEGER "integer" }
+        { DOUBLE "real" }
         { TIMESTAMP "timestamp" }
     } ;
 
@@ -278,12 +284,13 @@ M: postgresql-db create-type-table ( -- hash )
 
 : postgresql-compound ( str n -- newstr )
     over {
-        { "varchar" [ first number>string join-space ] }
+        { "default" [ first number>string join-space ] }
-        { "references"
+        { "varchar" [ first number>string paren append ] }
-            [
+        { "references" [
                 first2 >r [ unparse join-space ] keep db-columns r>
-                swap [ sql-spec-slot-name = ] with find nip sql-spec-column-name paren append
+                swap [ sql-spec-slot-name = ] with find nip
-                ] }
+                sql-spec-column-name paren append
+            ] }
         [ "no compound found" 3array throw ]
     } case ;
 

extra/db/sqlite/lib/lib.factor

@@ -79,6 +79,7 @@ IN: db.sqlite.lib
         { VARCHAR [ sqlite-bind-text-by-name ] }
         { DOUBLE [ sqlite-bind-double-by-name ] }
         { TIMESTAMP [ sqlite-bind-double-by-name ] }
+        { +native-id+ [ sqlite-bind-int-by-name ] }
         ! { NULL [ sqlite-bind-null-by-name ] }
         [ no-sql-type ]
     } case ;

extra/db/sqlite/sqlite.factor

@@ -4,7 +4,7 @@ USING: alien arrays assocs classes compiler db
 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 ;
+words combinators.lib db.types combinators tools.walker ;
 IN: db.sqlite
 
 TUPLE: sqlite-db path ;
@@ -99,7 +99,7 @@ M: sqlite-db create-sql ( specs table -- sql )
 
 M: sqlite-db drop-sql ( specs table -- sql )
     [
-        "drop table " % % ";" %
+        "drop table " % % ";" % drop
     ] "" make ;
 
 M: sqlite-db insert-sql* ( specs table -- sql )
@@ -161,9 +161,9 @@ M: sqlite-db select-sql ( tuple -- sql )
 
 M: sqlite-db tuple>params ( specs tuple -- obj )
     [
-        >r [ second ":" swap append ] keep r>
+        >r [ sql-spec-column-name ":" swap append ] keep r>
-        dupd >r first r> get-slot-named swap
+        dupd >r sql-spec-slot-name r> get-slot-named swap
-        third 3array
+        sql-spec-type 3array
     ] curry map ;
 
 M: sqlite-db modifier-table ( -- hashtable )

extra/db/tuples/tuples-tests.factor

@@ -2,19 +2,18 @@
 ! 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
-prettyprint ;
+prettyprint tools.walker ;
-! tools.time ;
 IN: temporary
 
-TUPLE: person the-id the-name the-number real ;
+TUPLE: person the-id the-name the-number the-real ;
 : <person> ( name age real -- person )
     {
         set-person-the-name
         set-person-the-number
-        set-person-real
+        set-person-the-real
     } person construct ;
 
-: <assigned-person> ( id name number real -- obj )
+: <assigned-person> ( id name number the-real -- obj )
     <person> [ set-person-the-id ] keep ;
 
 SYMBOL: the-person
@@ -31,8 +30,10 @@ SYMBOL: the-person
 
     [ ] [ the-person get update-tuple ] unit-test
 
+    ! T{ person f f f 200 f } select-tuples
+
     [ ] [ the-person get delete-tuple ] unit-test
-    ; ! 1 [ ] [ person drop-table ] unit-test ;
+    [ ] [ person drop-table ] unit-test ;
 
 : test-sqlite ( -- )
     "tuples-test.db" resource-path <sqlite-db> [
@@ -49,20 +50,20 @@ person "PERSON"
     { "the-id" "ID" +native-id+ }
     { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
     { "the-number" "AGE" INTEGER { +default+ 0 } }
-    { "real" "REAL" DOUBLE { +default+ 0.3 } }
+    { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
 } define-persistent
 
 "billy" 10 3.14 <person> the-person set
 
-test-sqlite
+! test-sqlite
-! test-postgresql
+test-postgresql
 
 ! person "PERSON"
 ! {
     ! { "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 } }
+    ! { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
 ! } define-persistent
 
 ! 1 "billy" 20 6.28 <assigned-person> the-person set
@@ -95,11 +96,11 @@ annotation "ANNOTATION"
     { "contents" "CONTENTS" TEXT }
 } define-persistent
 
-"localhost" "postgres" "" "factor-test" <postgresql-db> [
+! "localhost" "postgres" "" "factor-test" <postgresql-db> [
-    [ paste drop-table ] [ drop ] recover
+    ! [ paste drop-table ] [ drop ] recover
-    [ annotation drop-table ] [ drop ] recover
+    ! [ annotation drop-table ] [ drop ] recover
-    [ paste drop-table ] [ drop ] recover
+    ! [ paste drop-table ] [ drop ] recover
-    [ annotation drop-table ] [ drop ] recover
+    ! [ annotation drop-table ] [ drop ] recover
-    paste create-table
+    ! [ ] [ paste create-table ] unit-test
-    annotation create-table
+    ! [ ] [ annotation create-table ] unit-test
-] with-db
+! ] with-db

extra/db/tuples/tuples.factor

@@ -3,7 +3,7 @@
 USING: arrays assocs classes db kernel namespaces
 tuples words sequences slots slots.private math
 math.parser io prettyprint db.types continuations
-mirrors sequences.lib ;
+mirrors sequences.lib tools.walker ;
 IN: db.tuples
 
 : db-table ( class -- obj ) "db-table" word-prop ;
@@ -33,7 +33,7 @@ TUPLE: no-slot-named ;
     dup class primary-key-spec get-slot-named ;
 
 : set-primary-key ( obj tuple -- )
-    [ class primary-key-spec first ] keep
+    [ class primary-key-spec sql-spec-slot-name ] keep
     set-slot-named ;
 
 : cache-statement ( columns class assoc quot -- statement )
@@ -92,7 +92,7 @@ HOOK: tuple>params db ( columns tuple -- obj )
 : delete-tuple ( tuple -- )
     [ [ primary-key? ] subset ] [ delete-sql ] do-tuple-statement ;
 
-: select-tuple ( tuple -- )
+: select-tuples ( tuple -- )
     [ select-sql ] keep do-query ;
 
 : persist ( tuple -- )

extra/db/types/types.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs db kernel math math.parser
 sequences continuations sequences.deep sequences.lib
-words namespaces ;
+words namespaces tools.walker ;
 IN: db.types
 
 TUPLE: sql-spec slot-name column-name type modifiers primary-key ;
@@ -12,15 +12,18 @@ SYMBOL: +native-id+
 ! +assigned-id+ can only be a modifier
 SYMBOL: +assigned-id+
 
-: primary-key? ( obj -- ? )
+: (primary-key?) ( obj -- ? )
     { +native-id+ +assigned-id+ } member? ;
 
+: primary-key? ( spec -- ? )
+    sql-spec-primary-key (primary-key?) ;
+
 : normalize-spec ( spec -- )
-    dup sql-spec-type dup primary-key? [
+    dup sql-spec-type dup (primary-key?) [
         swap set-sql-spec-primary-key
     ] [
         drop dup sql-spec-modifiers [
-            primary-key?
+            (primary-key?)
         ] deep-find
         [ swap set-sql-spec-primary-key ] [ drop ] if*
     ] if ;