before major overhaul on return values

extra/db/sqlite/lib/lib.factor

@@ -2,7 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types arrays assocs kernel math math.parser
 namespaces sequences db.sqlite.ffi db combinators
-continuations db.types ;
+continuations db.types calendar.format serialize
+io.streams.string byte-arrays ;
+USE: tools.walker
 IN: db.sqlite.lib
 
 : sqlite-error ( n -- * )
@@ -55,6 +57,10 @@ IN: db.sqlite.lib
 : sqlite-bind-null ( handle i -- )
     sqlite3_bind_null sqlite-check-result ;
 
+: sqlite-bind-blob ( handle i byte-array -- )
+    dup length SQLITE_TRANSIENT
+    sqlite3_bind_blob sqlite-check-result ;
+
 : sqlite-bind-text-by-name ( handle name text -- )
     parameter-index sqlite-bind-text ;
 
@@ -67,20 +73,33 @@ IN: db.sqlite.lib
 : sqlite-bind-double-by-name ( handle name double -- )
     parameter-index sqlite-bind-double ;
 
+: sqlite-bind-blob-by-name ( handle name blob -- )
+    parameter-index sqlite-bind-blob ;
+
 : sqlite-bind-null-by-name ( handle name obj -- )
     parameter-index drop sqlite-bind-null ;
 
 : sqlite-bind-type ( handle key value type -- )
+    over [ drop NULL ] unless
     dup array? [ first ] when
     {
         { INTEGER [ sqlite-bind-int-by-name ] }
-        { BIG_INTEGER [ sqlite-bind-int64-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 ] }
-        { TIMESTAMP [ sqlite-bind-double-by-name ] }
+        { DATE [ sqlite-bind-text-by-name ] }
+        { TIME [ sqlite-bind-text-by-name ] }
+        { DATETIME [ sqlite-bind-text-by-name ] }
+        { TIMESTAMP [ sqlite-bind-text-by-name ] }
+        { BLOB [ sqlite-bind-blob-by-name ] }
+        { FACTOR-BLOB [
+            break
+            [ serialize ] with-string-writer >byte-array
+            sqlite-bind-blob-by-name
+        ] }
         { +native-id+ [ sqlite-bind-int-by-name ] }
-        ! { NULL [ sqlite-bind-null-by-name ] }
+        { NULL [ sqlite-bind-null-by-name ] }
         [ no-sql-type ]
     } case ;
 
@@ -93,21 +112,20 @@ IN: db.sqlite.lib
 : sqlite-#columns ( query -- int )
     sqlite3_column_count ;
 
-! TODO
 : sqlite-column ( handle index -- string )
     sqlite3_column_text ;
 
 : sqlite-column-typed ( handle index type -- obj )
     {
         { INTEGER [ sqlite3_column_int ] }
-        { BIG_INTEGER [ sqlite3_column_int64 ] }
+        { BIG-INTEGER [ sqlite3_column_int64 ] }
         { TEXT [ sqlite3_column_text ] }
         { DOUBLE [ sqlite3_column_double ] }
         { TIMESTAMP [ sqlite3_column_double ] }
+        ! { NULL [ 2drop f ] }
         [ no-sql-type ]
     } case ;
 
-! TODO
 : sqlite-row ( handle -- seq )
     dup sqlite-#columns [ sqlite-column ] with map ;
 

extra/db/sqlite/sqlite.factor

@@ -179,8 +179,7 @@ M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
             " where " 0%
             [ ", " 0% ]
             [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
-            ";" 0%
+        ] if ";" 0%
-        ] if
     ] sqlite-make ;
 
 M: sqlite-db modifier-table ( -- hashtable )
@@ -209,8 +208,13 @@ M: sqlite-db type-table ( -- assoc )
         { INTEGER "integer" }
         { TEXT "text" }
         { VARCHAR "text" }
+        { DATE "date" }
+        { TIME "time" }
+        { DATETIME "datetime" }
         { TIMESTAMP "timestamp" }
         { DOUBLE "real" }
+        { BLOB "blob" }
+        { FACTOR-BLOB "blob" }
     } ;
 
 M: sqlite-db create-type-table

extra/db/tuples/tuples-tests.factor

@@ -2,39 +2,45 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files kernel tools.test db db.tuples
 db.types continuations namespaces db.postgresql math
-prettyprint tools.walker db.sqlite ;
+prettyprint tools.walker db.sqlite calendar ;
 IN: db.tuples.tests
 
-TUPLE: person the-id the-name the-number the-real ;
+TUPLE: person the-id the-name the-number the-real ts date time blob ;
 : <person> ( name age real -- person )
     {
         set-person-the-name
         set-person-the-number
         set-person-the-real
+        set-person-ts
+        set-person-date
+        set-person-time
+        set-person-blob
     } person construct ;
 
 : <assigned-person> ( id name number the-real -- obj )
     <person> [ set-person-the-id ] keep ;
 
-SYMBOL: the-person1
+SYMBOL: person1
-SYMBOL: the-person2
+SYMBOL: person2
+SYMBOL: person3
+SYMBOL: person4
 
 : test-tuples ( -- )
     [ person drop-table ] [ drop ] recover
     [ ] [ person create-table ] unit-test
     [ person create-table ] must-fail
     
-    [ ] [ the-person1 get insert-tuple ] unit-test
+    [ ] [ person1 get insert-tuple ] unit-test
 
-    [ 1 ] [ the-person1 get person-the-id ] unit-test
+    [ 1 ] [ person1 get person-the-id ] unit-test
 
-    200 the-person1 get set-person-the-number
+    200 person1 get set-person-the-number
 
-    [ ] [ the-person1 get update-tuple ] unit-test
+    [ ] [ person1 get update-tuple ] unit-test
 
     [ T{ person f 1 "billy" 200 3.14 } ]
     [ T{ person f 1 } select-tuple ] unit-test
-    [ ] [ the-person2 get insert-tuple ] unit-test
+    [ ] [ person2 get insert-tuple ] unit-test
     [
         {
             T{ person f 1 "billy" 200 3.14 }
@@ -49,8 +55,19 @@ SYMBOL: the-person2
     ] [ T{ person f } select-tuples ] unit-test
 
 
-    [ ] [ the-person1 get delete-tuple ] unit-test
+    [ ] [ person1 get delete-tuple ] unit-test
     [ f ] [ T{ person f 1 } select-tuple ] unit-test
+
+    [ ] [ person3 get insert-tuple ] unit-test
+
+    [
+        T{ person f 3 "teddy" 10 3.14
+            T{ timestamp f 2008 3 5 16 24 11 0 }
+            T{ timestamp f 2008 11 22 f f f f }
+            T{ timestamp f f f f 12 34 56 f }
+            "storeinablob" }
+    ] [ T{ person f 3 } select-tuple ] unit-test
+
     [ ] [ person drop-table ] unit-test ;
 
 : make-native-person-table ( -- )
@@ -67,9 +84,14 @@ SYMBOL: the-person2
         { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
         { "the-number" "AGE" INTEGER { +default+ 0 } }
         { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+        { "ts" "TS" TIMESTAMP }
+        { "date" "D" DATE }
+        { "time" "T" TIME }
+        { "blob" "B" BLOB }
     } define-persistent
-    "billy" 10 3.14 <person> the-person1 set
+    "billy" 10 3.14 f f f f <person> person1 set
-    "johnny" 10 3.14 <person> the-person2 set ;
+    "johnny" 10 3.14 f f f f <person> person2 set
+    "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } <person> person3 set ;
 
 : assigned-person-schema ( -- )
     person "PERSON"
@@ -78,10 +100,14 @@ SYMBOL: the-person2
         { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
         { "the-number" "AGE" INTEGER { +default+ 0 } }
         { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+        { "ts" "TS" TIMESTAMP }
+        { "date" "D" DATE }
+        { "time" "T" TIME }
+        { "blob" "B" BLOB }
     } define-persistent
-    1 "billy" 10 3.14 <assigned-person> the-person1 set
+    1 "billy" 10 3.14 f f f f <assigned-person> person1 set
-    2 "johnny" 10 3.14 <assigned-person> the-person2 set ;
+    2 "johnny" 10 3.14 f f f f <assigned-person> person2 set
-
+    3 "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } <assigned-person> person3 set ;
 
 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 TUPLE: annotation n paste-id summary author mode contents ;
@@ -125,7 +151,22 @@ TUPLE: annotation n paste-id summary author mode contents ;
 : 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
+! [ native-person-schema test-tuples ] test-sqlite
+! [ assigned-person-schema test-tuples ] test-sqlite
+
+TUPLE: serialize-me id data ;
+[
+    serialize-me "SERIALIZED"
+    {
+        { "id" "ID" +native-id+ }
+        { "data" "DATA" FACTOR-BLOB }
+    } define-persistent
+    [ serialize-me drop-table ] [ drop ] recover
+    [ ] [ serialize-me create-table ] unit-test
+
+    [ ] [ T{ serialize-me f f H{ { 1 2 } } } insert-tuple ] unit-test
+    [ ] [ T{ serialize-me f 1 } select-tuples ] unit-test
+] test-sqlite
 
 ! [ make-native-person-table ] test-sqlite

extra/db/types/types.factor

@@ -3,7 +3,8 @@
 USING: arrays assocs db kernel math math.parser
 sequences continuations sequences.deep sequences.lib
 words namespaces tools.walker slots slots.private classes
-mirrors tuples combinators ;
+mirrors tuples combinators calendar.format serialize
+io.streams.string ;
 IN: db.types
 
 HOOK: modifier-table db ( -- hash )
@@ -60,14 +61,19 @@ SYMBOL: +has-many+
 : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ;
 
 SYMBOL: INTEGER
-SYMBOL: BIG_INTEGER
+SYMBOL: BIG-INTEGER
 SYMBOL: DOUBLE
 SYMBOL: REAL
 SYMBOL: BOOLEAN
 SYMBOL: TEXT
 SYMBOL: VARCHAR
-SYMBOL: TIMESTAMP
 SYMBOL: DATE
+SYMBOL: TIME
+SYMBOL: DATETIME
+SYMBOL: TIMESTAMP
+SYMBOL: BLOB
+SYMBOL: FACTOR-BLOB
+SYMBOL: NULL
 
 : spec>tuple ( class spec -- tuple )
     [ ?first3 ] keep 3 ?tail*
@@ -80,15 +86,6 @@ SYMBOL: DATE
     } sql-spec construct
     dup normalize-spec ;
 
-: sql-type-hash ( -- assoc )
-    H{
-        { INTEGER "integer" }
-        { TEXT "text" }
-        { VARCHAR "varchar" }
-        { DOUBLE "real" }
-        { TIMESTAMP "timestamp" }
-    } ;
-
 TUPLE: no-sql-type ;
 : no-sql-type ( -- * ) T{ no-sql-type } throw ;
 
@@ -212,13 +209,20 @@ TUPLE: no-slot-named ;
     ] curry { } map>assoc ;
 
 : sql-type>factor-type ( obj type -- obj )
+break
     dup array? [ first ] when
     {
         { +native-id+ [ string>number ] }
         { INTEGER [ string>number ] }
         { DOUBLE [ string>number ] }
         { REAL [ string>number ] }
+        { DATE [ dup [ ymd>timestamp ] when ] }
+        { TIME [ dup [ hms>timestamp ] when ] }
+        { DATETIME [ dup [ ymdhms>timestamp ] when ] }
+        { TIMESTAMP [ dup [ ymdhms>timestamp ] when ] }
         { TEXT [ ] }
         { VARCHAR [ ] }
+        { BLOB [ ] }
+        { FACTOR-BLOB [ break [ deserialize ] with-string-reader ] }
         [ "no conversion from sql type to factor type" throw ]
     } case ;