postgresql interval and range and sequence queries

extra/db/postgresql/postgresql.factor

@@ -39,9 +39,20 @@ M: postgresql-db dispose ( db -- )
 M: postgresql-statement bind-statement* ( statement -- )
     drop ;
 
+GENERIC: postgresql-bind-conversion
+
+M: sql-spec postgresql-bind-conversion ( tuple spec -- array )
+    slot-name>> swap get-slot-named ;
+
+M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- array )
+    nip value>> ;
+
+M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- array )
+    nip quot>> call ;
+
 M: postgresql-statement bind-tuple ( tuple statement -- )
     tuck in-params>>
-    [ slot-name>> swap get-slot-named ] with map
+    [ postgresql-bind-conversion ] with map
     >>bind-params drop ;
 
 M: postgresql-result-set #rows ( result-set -- n )
@@ -197,29 +208,12 @@ M: postgresql-db <insert-nonnative-statement> ( class -- statement )
 M: postgresql-db insert-tuple* ( tuple statement -- )
     query-modify-tuple ;
 
-M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
-    [
-        "select " 0%
-        over [ ", " 0% ]
-        [ dup column-name>> 0% 2, ] interleave
-
-        " from " 0% 0%
-        [ slot-name>> swap get-slot-named ] with subset
-        dup empty? [
-            drop
-        ] [
-            " where " 0%
-            [ " and " 0% ]
-            [ dup column-name>> 0% " = " 0% bind% ] interleave
-        ] if ";" 0%
-    ] query-make ;
-
 M: postgresql-db persistent-table ( -- hashtable )
     H{
         { +native-id+ { "integer" "serial primary key" f } }
         { +assigned-id+ { f f "primary key" } }
         { +random-id+ { "bigint" "bigint primary key" f } }
-        { TEXT { "text" f f } }
+        { TEXT { "text" "text" f } }
         { VARCHAR { "varchar" "varchar" f } }
         { INTEGER { "integer" "integer" f } }
         { BIG-INTEGER { "bigint" "bigint" f } }

extra/db/queries/queries.factor

@@ -1,7 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math namespaces sequences random
-math.bitfields.lib namespaces.lib db db.tuples db.types ;
+strings
+math.bitfields.lib namespaces.lib db db.tuples db.types
+math.intervals ;
 IN: db.queries
 
 : maybe-make-retryable ( statement -- statement )
@@ -42,3 +44,55 @@ M: db <delete-tuple-statement> ( specs table -- sql )
 M: db random-id-quot ( -- quot )
     [ 63 [ 2^ random ] keep 1 - set-bit ] ;
 
+GENERIC: where ( specs obj -- )
+
+: interval-comparison ( ? str -- str )
+    "from" = " >" " <" ? swap [ "= " append ] when ;
+
+: where-interval ( spec obj from/to -- )
+    pick column-name>> 0%
+    >r first2 r> interval-comparison 0%
+    bind# ;
+
+: in-parens ( quot -- )
+    "(" 0% call ")" 0% ; inline
+
+M: interval where ( spec obj -- )
+    [
+        [ from>> "from" where-interval " and " 0% ]
+        [ to>> "to" where-interval ] 2bi
+    ] in-parens ;
+
+M: sequence where ( spec obj -- )
+    [
+        [ " or " 0% ] [ dupd where ] interleave drop
+    ] in-parens ;
+
+: object-where ( spec obj -- )
+    over column-name>> 0% " = " 0% bind# ;
+
+M: object where ( spec obj -- ) object-where ;
+
+M: integer where ( spec obj -- ) object-where ;
+
+M: string where ( spec obj -- ) object-where ;
+
+: where-clause ( tuple specs -- )
+    " where " 0% [
+        " and " 0%
+    ] [
+        2dup slot-name>> swap get-slot-named where
+    ] interleave drop ;
+
+M: db <select-by-slots-statement> ( tuple class -- statement )
+    [
+        "select " 0%
+        over [ ", " 0% ]
+        [ dup column-name>> 0% 2, ] interleave
+
+        " from " 0% 0%
+        dupd
+        [ slot-name>> swap get-slot-named ] with subset
+        dup empty? [ 2drop ] [ where-clause ] if ";" 0%
+    ] query-make ;
+

extra/db/sqlite/sqlite.factor

@@ -156,58 +156,6 @@ M: sqlite-db bind# ( spec obj -- )
 M: sqlite-db bind% ( spec -- )
     dup 1, column-name>> ":" prepend 0% ;
 
-GENERIC: where ( specs obj -- )
-
-: interval-comparison ( ? str -- str )
-    "from" = " >" " <" ? swap [ "= " append ] when ;
-
-: where-interval ( spec obj from/to -- )
-    pick column-name>> 0%
-    >r first2 r> interval-comparison 0%
-    bind# ;
-
-: in-parens ( quot -- )
-    "(" 0% call ")" 0% ; inline
-
-M: interval where ( spec obj -- )
-    [
-        [ from>> "from" where-interval " and " 0% ]
-        [ to>> "to" where-interval ] 2bi
-    ] in-parens ;
-
-M: sequence where ( spec obj -- )
-    [
-        [ " or " 0% ] [ dupd where ] interleave drop
-    ] in-parens ;
-
-: object-where ( spec obj -- )
-    over column-name>> 0% " = " 0% bind# ;
-
-M: object where ( spec obj -- ) object-where ;
-
-M: integer where ( spec obj -- ) object-where ;
-
-M: string where ( spec obj -- ) object-where ;
-
-: where-clause ( tuple specs -- )
-    " where " 0% [
-        " and " 0%
-    ] [
-        2dup slot-name>> swap get-slot-named where
-    ] interleave drop ;
-
-M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
-    [
-        "select " 0%
-        over [ ", " 0% ]
-        [ dup column-name>> 0% 2, ] interleave
-
-        " from " 0% 0%
-        dupd
-        [ slot-name>> swap get-slot-named ] with subset
-        dup empty? [ 2drop ] [ where-clause ] if ";" 0%
-    ] query-make ;
-
 M: sqlite-db persistent-table ( -- assoc )
     H{
         { +native-id+ { "integer primary key" "integer primary key" f } }

extra/db/tuples/tuples-tests.factor

@@ -341,7 +341,7 @@ C: <secret> secret
 [ assigned-person-schema test-repeated-insert ] test-postgresql
 [ test-bignum ] test-postgresql
 [ test-serialize ] test-postgresql
-! [ test-intervals ] test-postgresql
+[ test-intervals ] test-postgresql
 ! [ test-random-id ] test-postgresql
 
 TUPLE: does-not-persist ;