postgresql interval and range and sequence queries

db4
Doug Coleman 2008-04-21 00:45:14 -05:00
parent 4da64986f3
commit 411fb2f97d
4 changed files with 69 additions and 73 deletions

View File

@ -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 } }

View File

@ -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 ;

View File

@ -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 } }

View File

@ -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 ;