sqlite now binds by type

all sqlite unit tests pass
change rebind-statement to reset-statement

extra/db/db.factor

@@ -34,22 +34,18 @@ HOOK: <simple-statement> db ( str -- statement )
 HOOK: <prepared-statement> db ( str -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
-GENERIC: rebind-statement ( obj statement -- )
+GENERIC: reset-statement ( statement -- )
 GENERIC: execute-statement ( statement -- )
 
 : bind-statement ( obj statement -- )
-    2dup dup statement-bound? [
-        rebind-statement
-    ] [
-        bind-statement*
-    ] if
-    tuck set-statement-params
+    dup statement-bound? [ dup reset-statement ] when
+    [ bind-statement* ] 2keep
+    [ 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 )

extra/db/sqlite/lib/lib.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types assocs kernel math math.parser
+USING: alien.c-types arrays assocs kernel math math.parser
 namespaces sequences db.sqlite.ffi db combinators
-continuations ;
+continuations db.types ;
 IN: db.sqlite.lib
 
 : sqlite-error ( n -- * )
@@ -40,30 +40,48 @@ IN: db.sqlite.lib
     >r dupd sqlite-bind-parameter-index r> ;
 
 : sqlite-bind-text ( handle index text -- )
-    ! dup number? [ number>string ] when
-    dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
+    dup length SQLITE_TRANSIENT
+    sqlite3_bind_text sqlite-check-result ;
 
-: sqlite-bind-int ( handle name n -- )
+: sqlite-bind-int ( handle i n -- )
     sqlite3_bind_int sqlite-check-result ;
 
-: sqlite-bind-int64 ( handle name n -- )
+: sqlite-bind-int64 ( handle i n -- )
     sqlite3_bind_int64 sqlite-check-result ;
 
-: sqlite-bind-null ( handle n -- )
+: sqlite-bind-double ( handle i x -- )
+    sqlite3_bind_double sqlite-check-result ;
+
+: sqlite-bind-null ( handle i -- )
     sqlite3_bind_null sqlite-check-result ;
 
 : sqlite-bind-text-by-name ( handle name text -- )
     parameter-index sqlite-bind-text ;
 
-: sqlite-bind-int-by-name ( handle name text -- )
+: sqlite-bind-int-by-name ( handle name int -- )
     parameter-index sqlite-bind-int ;
 
-: sqlite-bind-int64-by-name ( handle name text -- )
+: sqlite-bind-int64-by-name ( handle name int64 -- )
     parameter-index sqlite-bind-int ;
 
+: sqlite-bind-double-by-name ( handle name double -- )
+    parameter-index sqlite-bind-double ;
+
 : sqlite-bind-null-by-name ( handle name obj -- )
     parameter-index drop sqlite-bind-null ;
 
+: sqlite-bind-type ( handle key value type -- )
+    dup array? [ first ] when
+    {
+        { INTEGER [ sqlite-bind-int-by-name ] }
+        { BIG_INTEGER [ sqlite-bind-int-by-name ] }
+        { TEXT [ sqlite-bind-text-by-name ] }
+        { VARCHAR [ sqlite-bind-text-by-name ] }
+        { DOUBLE [ sqlite-bind-double-by-name ] }
+        ! { NULL [ sqlite-bind-null-by-name ] }
+        [ no-sql-type ]
+    } case ;
+
 : sqlite-finalize ( handle -- )
     sqlite3_finalize sqlite-check-result ;
 

extra/db/sqlite/sqlite-tests.factor

@@ -1,6 +1,6 @@
 USING: io io.files io.launcher kernel namespaces
 prettyprint tools.test db.sqlite db sequences
-continuations ;
+continuations db.types ;
 IN: temporary
 
 : test.db "extra/db/sqlite/test.db" resource-path ;
@@ -26,13 +26,13 @@ IN: temporary
     test.db [
         "select * from person where name = :name and country = :country"
         <simple-statement> [
-            { { ":name" "Jane" } { ":country" "New Zealand" } }
+            { { ":name" "Jane" TEXT } { ":country" "New Zealand" TEXT } }
             over do-bound-query
 
             { { "Jane" "New Zealand" } } =
             [ "test fails" throw ] unless
 
-            { { ":name" "John" } { ":country" "America" } }
+            { { ":name" "John" TEXT } { ":country" "America" TEXT } }
             swap do-bound-query
         ] with-disposal
     ] with-sqlite

extra/db/sqlite/sqlite.factor

@@ -44,16 +44,13 @@ M: sqlite-result-set dispose ( result-set -- )
     f swap set-result-set-handle ;
 
 : sqlite-bind ( triples handle -- )
-    [
-        -rot sqlite-bind-text-by-name
-    ] curry assoc-each ;
+    swap [ first3 sqlite-bind-type ] with each ;
 
 M: sqlite-statement bind-statement* ( triples statement -- )
     statement-handle sqlite-bind ;
 
-M: sqlite-statement rebind-statement ( triples statement -- )
-    dup statement-handle sqlite-reset
-    bind-statement* ;
+M: sqlite-statement reset-statement ( statement -- )
+    statement-handle sqlite-reset ;
 
 M: sqlite-statement execute-statement ( statement -- )
     statement-handle sqlite-next drop ;
@@ -123,7 +120,7 @@ M: sqlite-db delete-sql* ( columns table -- sql )
         %
         " where " %
         first second dup % " = :" % %
-    ] "" make dup . ;
+    ] "" make ;
 
 M: sqlite-db select-sql* ( columns table -- sql )
     [
@@ -136,9 +133,10 @@ M: sqlite-db select-sql* ( columns table -- sql )
 
 M: sqlite-db tuple>params ( columns tuple -- obj )
     [
-        >r [ second ":" swap append ] keep first r> get-slot-named
-        number>string*
-    ] curry { } map>assoc  ;
+        >r [ second ":" swap append ] keep r>
+        dupd >r first r> get-slot-named swap
+        third 3array
+    ] curry map ;
     
 M: sqlite-db last-id ( -- id )
     db get db-handle sqlite3_last_insert_rowid ;
@@ -171,6 +169,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
         { INTEGER "integer" }
         { TEXT "text" }
         { VARCHAR "text" }
+        { DOUBLE "real" }
     } ;
 
 M: sqlite-db >sql-type ( obj -- str )

extra/db/tuples/tuples-tests.factor

@@ -1,25 +1,25 @@
+! 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 ;
 IN: temporary
 
-TUPLE: person the-id the-name the-number ;
+TUPLE: person the-id the-name the-number real ;
 : <person> ( name age -- person )
-    { set-person-the-name set-person-the-number } person construct ;
+    {
+        set-person-the-name
+        set-person-the-number
+        set-person-real
+    } person construct ;
 
-person "PERSON"
-{
-    { "the-id" "ROWID" INTEGER +native-id+ }
-    { "the-name" "NAME" { VARCHAR 256 } +not-null+ } 
-    { "the-number" "AGE" INTEGER { +default+ 0 } }
-} define-persistent
+: <assigned-person> ( id name number real -- obj )
+    <person> [ set-person-the-id ] keep ;
 
 SYMBOL: the-person
 
 : test-tuples ( -- )
-    [ person drop-table ] [ ] recover
-    person create-table
-    f "billy" 100 person construct-boa
-    the-person set
+    [ person drop-table ] [ drop ] recover
+    [ ] [ person create-table ] unit-test
     
     [  ] [ the-person get insert-tuple ] unit-test
 
@@ -36,11 +36,33 @@ SYMBOL: the-person
         test-tuples
     ] with-db ;
 
-test-sqlite
-
 ! : test-postgres ( -- )
     ! resource-path <postgresql-db> [
         ! test-tuples
     ! ] with-db ;
 
+person "PERSON"
+{
+    { "the-id" "ROWID" INTEGER +native-id+ }
+    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "the-number" "AGE" INTEGER { +default+ 0 } }
+    { "real" "REAL" DOUBLE { +default+ 0.3 } }
+} define-persistent
+
+"billy" 10 3.14 <person> the-person set
+
+test-sqlite
+! test-postgres
+
+person "PERSON"
+{
+    { "the-id" "ROWID" INTEGER +assigned-id+ }
+    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "the-number" "AGE" INTEGER { +default+ 0 } }
+    { "real" "REAL" DOUBLE { +default+ 0.3 } }
+} define-persistent
+
+1 "billy" 20 6.28 <assigned-person> the-person set
+
+test-sqlite
 ! test-postgres

extra/db/tuples/tuples.factor

@@ -61,11 +61,12 @@ HOOK: tuple>params db ( columns tuple -- obj )
 
 : tuple-statement ( columns tuple quot -- statement )
     >r [ tuple>params ] 2keep class r> call
+    2dup . .
     [ bind-statement ] keep ;
 
 : do-tuple-statement ( tuple columns-quot statement-quot -- )
     >r [ class db-columns ] swap compose keep
-    r> tuple-statement dup . execute-statement ;
+    r> tuple-statement execute-statement ;
 
 : create-table ( class -- )
     dup db-columns swap db-table create-sql sql-command ;

extra/db/types/types.factor

@@ -22,10 +22,6 @@ SYMBOL: +not-null+
 
 SYMBOL: +has-many+
 
-! SQLite Types
-! http://www.sqlite.org/datatype3.html
-! NULL INTEGER REAL TEXT BLOB
-
 SYMBOL: INTEGER
 SYMBOL: DOUBLE
 SYMBOL: BOOLEAN
@@ -38,19 +34,17 @@ SYMBOL: DATE
 
 SYMBOL: BIG_INTEGER
 
-! PostgreSQL Types
-! http://developer.postgresql.org/pgdocs/postgres/datatype.html
-
-
-: number>string* ( num/str -- str )
-    dup number? [ number>string ] when ;
-
 TUPLE: no-sql-type ;
+: no-sql-type ( -- * ) T{ no-sql-type } throw ;
+
 HOOK: sql-modifiers* db ( modifiers -- str )
 HOOK: >sql-type db ( obj -- str )
 
 ! HOOK: >factor-type db ( obj -- obj )
 
+: number>string* ( n/str -- str )
+    dup number? [ number>string ] when ;
+
 : maybe-remove-id ( columns -- obj )
     [ +native-id+ swap member? not ] subset ;
 
@@ -59,3 +53,8 @@ HOOK: >sql-type db ( obj -- str )
 
 : sql-modifiers ( spec -- seq )
     3 tail sql-modifiers* ;
+
+! SQLite Types: http://www.sqlite.org/datatype3.html
+! NULL INTEGER REAL TEXT BLOB
+! PostgreSQL Types:
+! http://developer.postgresql.org/pgdocs/postgres/datatype.html