diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index fc3b08d9b9..057c5f5168 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/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 ( class -- statement ) M: postgresql-db insert-tuple* ( tuple statement -- ) query-modify-tuple ; -M: postgresql-db ( 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 } } diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor index 79c1909c05..7053eefba1 100644 --- a/extra/db/queries/queries.factor +++ b/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 ( 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 ( 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 ; + diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index b948fb1696..f4247cf6d8 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/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 ( 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 } } diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index c6870bd703..026370e806 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -341,7 +341,7 @@ C: 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 ;