sqlite now gets return types with the optimized native functions

removed a hack in type conversion
serialize arbitrary factor objects to db

extra/db/db.factor

@@ -34,7 +34,7 @@ HOOK: db-close db ( handle -- )
 TUPLE: statement handle sql in-params out-params bind-params bound? ;
 TUPLE: simple-statement ;
 TUPLE: prepared-statement ;
-TUPLE: result-set sql params handle n max ;
+TUPLE: result-set sql in-params out-params handle n max ;
 : <statement> ( sql in out -- statement )
     { (>>sql) (>>in-params) (>>out-params) } statement construct ;
 
@@ -47,6 +47,7 @@ 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# row-column-typed 1 ( result-set n -- sql )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 
@@ -67,13 +68,16 @@ GENERIC: more-rows? ( result-set -- ? )
     0 >>n drop ;
 
 : <result-set> ( query handle tuple -- result-set )
-    >r >r { sql>> in-params>> } get-slots r>
+    >r >r { sql>> in-params>> out-params>> } get-slots r>
-    { (>>sql) (>>params) (>>handle) } result-set
+    { (>>sql) (>>in-params) (>>out-params) (>>handle) } result-set
     construct r> construct-delegate ;
 
 : sql-row ( result-set -- seq )
     dup #columns [ row-column ] with map ;
 
+: sql-row-typed ( result-set -- seq )
+    dup #columns [ row-column-typed ] with map ;
+
 : query-each ( statement quot -- )
     over more-rows? [
         [ call ] 2keep over advance-row query-each

extra/db/sqlite/lib/lib.factor

@@ -94,7 +94,6 @@ IN: db.sqlite.lib
         { 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
         ] }
@@ -115,13 +114,31 @@ IN: db.sqlite.lib
 : sqlite-column ( handle index -- string )
     sqlite3_column_text ;
 
+: sqlite-column-blob ( handle index -- byte-array/f )
+    [ sqlite3_column_bytes ] 2keep
+    pick zero? [
+        3drop f
+    ] [
+        sqlite3_column_blob swap memory>byte-array
+    ] if ;
+
 : sqlite-column-typed ( handle index type -- obj )
+    dup array? [ first ] when
     {
+        { +native-id+ [ sqlite3_column_int64 ] }
         { INTEGER [ sqlite3_column_int ] }
         { BIG-INTEGER [ sqlite3_column_int64 ] }
         { TEXT [ sqlite3_column_text ] }
+        { VARCHAR [ sqlite3_column_text ] }
         { DOUBLE [ sqlite3_column_double ] }
-        { TIMESTAMP [ sqlite3_column_double ] }
+        { DATE [ sqlite3_column_text dup [ ymd>timestamp ] when ] }
+        { TIME [ sqlite3_column_text dup [ hms>timestamp ] when ] }
+        { TIMESTAMP [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
+        { DATETIME [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
+        { BLOB [ sqlite-column-blob ] }
+        { FACTOR-BLOB [
+            sqlite-column-blob [ deserialize ] with-string-reader
+        ] }
         ! { NULL [ 2drop f ] }
         [ no-sql-type ]
     } case ;

extra/db/sqlite/sqlite.factor

@@ -80,8 +80,9 @@ 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 row-column-typed ( result-set n type -- obj )
+M: sqlite-result-set row-column-typed ( result-set n -- obj )
-    >r result-set-handle r> sqlite-column-typed ;
+    dup pick result-set-out-params nth sql-spec-type
+    >r >r result-set-handle r> r> sqlite-column-typed ;
 
 M: sqlite-result-set advance-row ( result-set -- )
     [ result-set-handle sqlite-next ] keep

extra/db/tuples/tuples-tests.factor

@@ -61,11 +61,18 @@ SYMBOL: person4
     [ ] [ person3 get insert-tuple ] unit-test
 
     [
-        T{ person f 3 "teddy" 10 3.14
+        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" }
+            B{ 115 116 111 114 101 105 110 97 98 108 111 98 }
+        }
     ] [ T{ person f 3 } select-tuple ] unit-test
 
     [ ] [ person drop-table ] unit-test ;
@@ -152,8 +159,8 @@ TUPLE: annotation n paste-id summary author mode contents ;
     >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
 
 
-! [ native-person-schema test-tuples ] test-sqlite
+[ native-person-schema test-tuples ] test-sqlite
-! [ assigned-person-schema test-tuples ] test-sqlite
+[ assigned-person-schema test-tuples ] test-sqlite
 
 TUPLE: serialize-me id data ;
 [
@@ -166,7 +173,9 @@ TUPLE: serialize-me id data ;
     [ ] [ 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
+    [
+        { T{ serialize-me f 1 H{ { 1 2 } } } }
+    ] [ T{ serialize-me f 1 } select-tuples ] unit-test
 ] test-sqlite
 
 ! [ make-native-person-table ] test-sqlite

extra/db/tuples/tuples.factor

@@ -37,27 +37,24 @@ HOOK: <delete-tuples-statement> db ( class -- obj )
 
 HOOK: <select-by-slots-statement> db ( tuple -- tuple )
 
-HOOK: row-column-typed db ( result-set n type -- sql )
 HOOK: insert-tuple* db ( tuple statement -- )
 
 : resulting-tuple ( row out-params -- tuple )
     dup first sql-spec-class construct-empty [
         [
-            >r [ sql-spec-type sql-type>factor-type ] keep
+            >r sql-spec-slot-name r> set-slot-named
-            sql-spec-slot-name r> set-slot-named
         ] curry 2each
     ] keep ;
 
 : query-tuples ( statement -- seq )
     [ statement-out-params ] keep query-results [
-        [ sql-row swap resulting-tuple ] with query-map
+        [ sql-row-typed swap resulting-tuple ] with query-map
     ] with-disposal ;
  
 : query-modify-tuple ( tuple statement -- )
-    [ query-results [ sql-row ] with-disposal ] keep
+    [ query-results [ sql-row-typed ] with-disposal ] keep
     statement-out-params rot [
-        >r [ sql-spec-type sql-type>factor-type ] keep
+        >r sql-spec-slot-name r> set-slot-named
-        sql-spec-slot-name r> set-slot-named
     ] curry 2each ;
 
 : sql-props ( class -- columns table )

extra/db/types/types.factor

@@ -207,22 +207,3 @@ TUPLE: no-slot-named ;
         >r dup sql-spec-type swap sql-spec-slot-name r>
         get-slot-named swap
     ] 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 ;