diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor index 7f3eaff84c..43ca4f369c 100644 --- a/extra/db/queries/queries.factor +++ b/extra/db/queries/queries.factor @@ -15,7 +15,7 @@ GENERIC: where ( specs obj -- ) : query-make ( class quot -- ) >r sql-props r> - [ 0 sql-counter rot with-variable ] { "" { } { } } nmake + [ 0 sql-counter rot with-variable ";" 0% ] { "" { } { } } nmake maybe-make-retryable ; inline M: db begin-transaction ( -- ) "BEGIN" sql-command ; @@ -44,18 +44,40 @@ M: random-id-generator eval-generator ( singleton -- obj ) : interval-comparison ( ? str -- str ) "from" = " >" " <" ? swap [ "= " append ] when ; +: fp-infinity? ( float -- ? ) + dup float? [ + double>bits -52 shift 11 2^ 1- [ bitand ] keep = + ] [ + drop f + ] if ; + +: (infinite-interval?) ( interval -- ?1 ?2 ) + [ from>> ] [ to>> ] bi + [ first fp-infinity? ] bi@ ; + +: double-infinite-interval? ( obj -- ? ) + dup interval? [ (infinite-interval?) and ] [ drop f ] if ; + +: infinite-interval? ( obj -- ? ) + dup interval? [ (infinite-interval?) or ] [ drop f ] if ; + : where-interval ( spec obj from/to -- ) - pick column-name>> 0% - >r first2 r> interval-comparison 0% - bind# ; + over first fp-infinity? [ + 3drop + ] [ + pick column-name>> 0% + >r first2 r> interval-comparison 0% + bind# + ] if ; : in-parens ( quot -- ) "(" 0% call ")" 0% ; inline M: interval where ( spec obj -- ) [ - [ from>> "from" where-interval " and " 0% ] - [ to>> "to" where-interval ] 2bi + [ from>> "from" where-interval ] [ + nip infinite-interval? [ " and " 0% ] unless + ] [ to>> "to" where-interval ] 2tri ] in-parens ; M: sequence where ( spec obj -- ) @@ -72,19 +94,28 @@ M: integer where ( spec obj -- ) object-where ; M: string where ( spec obj -- ) object-where ; +: filter-slots ( tuple specs -- specs' ) + [ + slot-name>> swap get-slot-named + dup double-infinite-interval? [ drop f ] when + ] with filter ; + : where-clause ( tuple specs -- ) - " where " 0% [ - " and " 0% + dupd filter-slots + dup empty? [ + 2drop ] [ - 2dup slot-name>> swap get-slot-named where - ] interleave drop ; + " where " 0% [ + " and " 0% + ] [ + 2dup slot-name>> swap get-slot-named where + ] interleave drop + ] if ; M: db ( tuple table -- sql ) [ "delete from " 0% 0% - dupd - [ slot-name>> swap get-slot-named ] with filter - dup empty? [ 2drop ] [ where-clause ] if ";" 0% + where-clause ] query-make ; M: db ( tuple class -- statement ) @@ -94,7 +125,5 @@ M: db ( tuple class -- statement ) [ dup column-name>> 0% 2, ] interleave " from " 0% 0% - dupd - [ slot-name>> swap get-slot-named ] with filter - dup empty? [ 2drop ] [ where-clause ] if ";" 0% + where-clause ] query-make ; diff --git a/extra/db/sql/sql.factor b/extra/db/sql/sql.factor index 184c45f8b1..82c6e370bd 100755 --- a/extra/db/sql/sql.factor +++ b/extra/db/sql/sql.factor @@ -1,7 +1,6 @@ USING: kernel parser quotations classes.tuple words math.order namespaces.lib namespaces sequences arrays combinators prettyprint strings math.parser sequences.lib math symbols ; -USE: tools.walker IN: db.sql SYMBOLS: insert update delete select distinct columns from as diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index f25ec12d1b..e92c4bbd8a 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/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 -tools.walker io.backend ; +io.backend ; IN: db.sqlite.lib : sqlite-error ( n -- * ) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index f5f229bfd2..8e6b9bfbe4 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel tools.test db db.tuples classes db.types continuations namespaces math math.ranges -prettyprint tools.walker calendar sequences db.sqlite -math.intervals db.postgresql accessors random math.bitfields.lib ; +prettyprint calendar sequences db.sqlite math.intervals +db.postgresql accessors random math.bitfields.lib ; IN: db.tuples.tests TUPLE: person the-id the-name the-number the-real @@ -30,6 +30,7 @@ SYMBOL: person3 SYMBOL: person4 : test-tuples ( -- ) + [ ] [ person recreate-table ] unit-test [ ] [ person ensure-table ] unit-test [ ] [ person drop-table ] unit-test [ ] [ person create-table ] unit-test @@ -292,6 +293,46 @@ TUPLE: exam id name score ; } ] [ T{ exam f T{ range f 1 3 1 } } select-tuples + ] unit-test + + [ + { + T{ exam f 2 "Stan" 80 } + T{ exam f 3 "Kenny" 60 } + T{ exam f 4 "Cartman" 41 } + } + ] [ + T{ exam f T{ interval f { 2 t } { 1.0/0.0 f } } } select-tuples + ] unit-test + + [ + { + T{ exam f 1 "Kyle" 100 } + } + ] [ + T{ exam f T{ interval f { -1.0/0.0 t } { 2 f } } } select-tuples + ] unit-test + + [ + { + T{ exam f 1 "Kyle" 100 } + T{ exam f 2 "Stan" 80 } + T{ exam f 3 "Kenny" 60 } + T{ exam f 4 "Cartman" 41 } + } + ] [ + T{ exam f T{ interval f { -1.0/0.0 t } { 1/0. f } } } select-tuples + ] unit-test + + [ + { + T{ exam f 1 "Kyle" 100 } + T{ exam f 2 "Stan" 80 } + T{ exam f 3 "Kenny" 60 } + T{ exam f 4 "Cartman" 41 } + } + ] [ + T{ exam } select-tuples ] unit-test ; TUPLE: bignum-test id m n o ; @@ -328,7 +369,7 @@ C: secret { "message" "MESSAGE" TEXT } } define-persistent - [ ] [ secret ensure-table ] unit-test + [ ] [ secret recreate-table ] unit-test [ t ] [ f "kilroy was here" [ insert-tuple ] keep n>> integer? ] unit-test @@ -342,7 +383,7 @@ C: secret ] unit-test [ t ] [ - T{ secret } select-tuples dup . length 3 = + T{ secret } select-tuples length 3 = ] unit-test ; [ db-assigned-person-schema test-tuples ] test-sqlite diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index afea61fc90..835b4b45d3 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -3,7 +3,7 @@ USING: arrays assocs classes db kernel namespaces classes.tuple words sequences slots math accessors math.parser io prettyprint db.types continuations -mirrors sequences.lib tools.walker combinators.lib ; +mirrors sequences.lib combinators.lib ; IN: db.tuples : define-persistent ( class table columns -- ) @@ -108,12 +108,15 @@ M: retryable execute-statement* ( statement type -- ) : drop-table ( class -- ) drop-sql-statement [ execute-statement ] with-disposals ; -: ensure-table ( class -- ) +: recreate-table ( class -- ) [ drop-sql-statement make-nonthrowable [ execute-statement ] with-disposals ] [ create-table ] bi ; +: ensure-table ( class -- ) + [ create-table ] curry ignore-errors ; + : insert-db-assigned-statement ( tuple -- ) dup class db get db-insert-statements [ ] cache diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 8328bd7626..8dbf6786bc 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs db kernel math math.parser sequences continuations sequences.deep sequences.lib -words namespaces tools.walker slots slots.private classes -mirrors classes.tuple combinators calendar.format symbols +words namespaces slots slots.private classes mirrors +classes.tuple combinators calendar.format symbols classes.singleton accessors quotations random ; IN: db.types