refactor <query>

add url objects

extra/db/postgresql/lib/lib.factor

@@ -5,7 +5,7 @@ quotations sequences db.postgresql.ffi alien alien.c-types
 db.types tools.walker ascii splitting math.parser combinators
 libc shuffle calendar.format byte-arrays destructors prettyprint
 accessors strings serialize io.encodings.binary io.encodings.utf8
-alien.strings io.streams.byte-array inspector ;
+alien.strings io.streams.byte-array inspector present urls ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -84,6 +84,7 @@ M: postgresql-result-null summary ( obj -- str )
             { TIME [ dup [ timestamp>hms ] when default-param-value ] }
             { DATETIME [ dup [ timestamp>ymdhms ] when default-param-value ] }
             { TIMESTAMP [ dup [ timestamp>ymdhms ] when default-param-value ] }
+            { URL [ dup [ present ] when default-param-value ] }
             [ drop default-param-value ]
         } case 2array
     ] 2map flip dup empty? [
@@ -164,6 +165,7 @@ M: postgresql-malloc-destructor dispose ( obj -- )
         { TIMESTAMP [ pq-get-string dup [ ymdhms>timestamp ] when ] }
         { DATETIME [ pq-get-string dup [ ymdhms>timestamp ] when ] }
         { BLOB [ pq-get-blob ] }
+        { URL [ pq-get-string dup [ >url ] when ] }
         { FACTOR-BLOB [
             pq-get-blob
             dup [ bytes>object ] when ] }

extra/db/postgresql/postgresql.factor

@@ -239,6 +239,7 @@ M: postgresql-db persistent-table ( -- hashtable )
         { TIMESTAMP { "timestamp" "timestamp" f } }
         { BLOB { "bytea" "bytea" f } }
         { FACTOR-BLOB { "bytea" "bytea" f } }
+        { URL { "string" "string" f } }
         { +foreign-id+ { f f "references" } }
         { +autoincrement+ { f f "autoincrement" } }
         { +unique+ { f f "unique" } }

extra/db/queries/queries.factor

@@ -149,14 +149,13 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
 : make-query ( tuple query -- tuple' )
     dupd
     {
-        [ group>> [ do-group ] [ drop ] if* ]
+        [ group>> [ do-group ] [ drop ] if-seq ]
-        [ order>> [ do-order ] [ drop ] if* ]
+        [ order>> [ do-order ] [ drop ] if-seq ]
         [ limit>> [ do-limit ] [ drop ] if* ]
         [ offset>> [ do-offset ] [ drop ] if* ]
     } 2cleave ;
 
-M: db <query> ( tuple class group order limit offset -- tuple )
+M: db <query> ( tuple class query -- tuple )
-    \ query boa
     [ <select-by-slots-statement> ] dip make-query ;
 
 ! select ID, NAME, SCORE from EXAM limit 1 offset 3
@@ -174,7 +173,8 @@ M: db <query> ( tuple class group order limit offset -- tuple )
     <simple-statement> maybe-make-retryable do-select ;
 
 M: db <count-statement> ( tuple class groups -- statement )
-    f f f \ query boa
+    \ query new
+        swap >>group
     [ [ "select count(*) from " 0% 0% where-clause ] query-make ]
     dip make-query ;
 

extra/db/sqlite/lib/lib.factor

@@ -4,7 +4,7 @@ USING: alien.c-types arrays assocs kernel math math.parser
 namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary
-io.backend db.errors ;
+io.backend db.errors present urls ;
 IN: db.sqlite.lib
 
 ERROR: sqlite-error < db-error n string ;
@@ -107,6 +107,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
             object>bytes
             sqlite-bind-blob-by-name
         ] }
+        { URL [ present sqlite-bind-text-by-name ] }
         { +db-assigned-id+ [ sqlite-bind-int-by-name ] }
         { +random-id+ [ sqlite-bind-int64-by-name ] }
         { NULL [ sqlite-bind-null-by-name ] }
@@ -147,6 +148,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
         { TIMESTAMP [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
         { DATETIME [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
         { BLOB [ sqlite-column-blob ] }
+        { URL [ sqlite3_column_text dup [ >url ] when ] }
         { FACTOR-BLOB [
             sqlite-column-blob
             dup [ bytes>object ] when

extra/db/sqlite/sqlite.factor

@@ -182,6 +182,7 @@ M: sqlite-db persistent-table ( -- assoc )
         { DOUBLE { "real" "real" } }
         { BLOB { "blob" "blob" } }
         { FACTOR-BLOB { "blob" "blob" } }
+        { URL { "text" "text" } }
         { +autoincrement+ { f f "autoincrement" } }
         { +unique+ { f f "unique" } }
         { +default+ { f f "default" } }

extra/db/tuples/tuples-tests.factor

@@ -342,7 +342,7 @@ TUPLE: exam id name score ;
         T{ exam } select-tuples
     ] unit-test
 
-    [ 4 ] [ T{ exam } count-tuples ] unit-test ;
+    [ 4 ] [ T{ exam } f count-tuples ] unit-test ;
 
 TUPLE: bignum-test id m n o ;
 : <bignum-test> ( m n o -- obj )

extra/db/tuples/tuples.factor

@@ -43,8 +43,8 @@ HOOK: <update-tuple-statement> db ( class -- obj )
 HOOK: <delete-tuples-statement> db ( tuple class -- obj )
 HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
 TUPLE: query group order offset limit ;
-HOOK: <query> db ( tuple class group order offset limit -- tuple )
+HOOK: <query> db ( tuple class query -- statement' )
-HOOK: <count-statement> db ( tuple class -- n )
+HOOK: <count-statement> db ( tuple class groups -- n )
 
 HOOK: insert-tuple* db ( tuple statement -- )
 
@@ -149,19 +149,14 @@ M: retryable execute-statement* ( statement type -- )
 : do-select ( exemplar-tuple statement -- tuples )
     [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
 
+: query ( tuple query -- tuples )
+    >r dup dup class r> <query> do-select ;
+
 : select-tuples ( tuple -- tuples )
     dup dup class <select-by-slots-statement> do-select ;
 
-: count-tuples ( tuple -- n )
-    select-tuples length ;
-
 : select-tuple ( tuple -- tuple/f )
-    dup dup class f f f 1 <query>
+    dup dup class \ query new 1 >>limit <query> do-select ?first ;
-    do-select ?first ;
-
-: query ( tuple groups order offset limit -- tuples )
-    >r >r >r >r dup dup class r> r> r> r>
-    <query> do-select ;
 
 : do-count ( exemplar-tuple statement -- tuples )
     [
@@ -170,6 +165,5 @@ M: retryable execute-statement* ( statement type -- )
 
 : count-tuples ( tuple groups -- n )
     >r dup dup class r> <count-statement> do-count
-    dup length 1 = [ first first string>number ] [
+    dup length 1 =
-        [ first string>number ] map
+    [ first first string>number ] [ [ first string>number ] map ] if ;
-    ] if ;

extra/db/types/types.factor

@@ -65,7 +65,7 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
 
 SYMBOLS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER
 DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB
-FACTOR-BLOB NULL ;
+FACTOR-BLOB NULL URL ;
 
 : spec>tuple ( class spec -- tuple )
     3 f pad-right