From 46262a6554d1ff78e92cc12361e67115a22c1692 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 23 Sep 2008 15:59:33 -0500 Subject: [PATCH 1/2] refactoring db.tuples, all tests pass so far.. --- basis/db/queries/queries.factor | 8 +++--- basis/db/tuples/tuples-tests.factor | 15 ++++++++++ basis/db/tuples/tuples.factor | 44 ++++++++++++++++++----------- 3 files changed, 46 insertions(+), 21 deletions(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 89c28b5262..300822cc50 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -168,7 +168,7 @@ M: db ( tuple class -- statement ) number>string " limit " swap 3append ] curry change-sql drop ; -: make-query ( tuple query -- tuple' ) +: make-query* ( tuple query -- tuple' ) dupd { [ group>> [ drop ] [ do-group ] if-empty ] @@ -177,8 +177,8 @@ M: db ( tuple class -- statement ) [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db ( tuple class query -- tuple ) - [ ] dip make-query ; +M: db make-query ( tuple class query -- tuple ) + [ ] dip make-query* ; ! select ID, NAME, SCORE from EXAM limit 1 offset 3 @@ -198,7 +198,7 @@ M: db ( tuple class groups -- statement ) \ query new swap >>group [ [ "select count(*) from " 0% 0% where-clause ] query-make ] - dip make-query ; + dip make-query* ; : create-index ( index-name table-name columns -- ) [ diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 67e46f9e18..466d086fbe 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -499,3 +499,18 @@ string-encoding-test "STRING_ENCODING_TEST" { \ ensure-table must-infer \ create-table must-infer \ drop-table must-infer + +: test-queries ( -- ) + [ ] [ exam ensure-table ] unit-test + ! [ ] [ T{ exam f f "Kyle" 100 } insert-tuple ] unit-test + ! [ ] [ T{ exam f f "Stan" 80 } insert-tuple ] unit-test + ! [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test + ! [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test + [ ] [ 10 [ random-exam insert-tuple ] times ] unit-test + [ ] [ ] unit-test + ! [ ] [ query ] unit-test + + ; + +: test-db ( -- ) + "tuples-test.db" temp-file sqlite-db make-db db-open db set ; diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 3c3bae3adc..534b91b8fc 100755 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -6,6 +6,30 @@ math.parser io prettyprint db.types continuations destructors mirrors ; IN: db.tuples +TUPLE: query tuple group order offset limit ; + +: ( -- query ) \ query new ; + +GENERIC: >query ( object -- query ) + +M: query >query ; + +M: tuple >query swap >>tuple ; + +! returns a sequence of prepared-statements +HOOK: create-sql-statement db ( class -- object ) +HOOK: drop-sql-statement db ( class -- object ) + +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( tuple class -- object ) +HOOK: db ( tuple class -- tuple ) +HOOK: db ( tuple class groups -- statement ) +HOOK: make-query db ( tuple class query -- statement ) + +HOOK: insert-tuple* db ( tuple statement -- ) + : define-persistent ( class table columns -- ) >r dupd "db-table" set-word-prop dup r> [ relation? ] partition swapd @@ -33,21 +57,6 @@ SYMBOL: sql-counter : next-sql-counter ( -- str ) sql-counter [ inc ] [ get ] bi number>string ; -! returns a sequence of prepared-statements -HOOK: create-sql-statement db ( class -- object ) -HOOK: drop-sql-statement db ( class -- object ) - -HOOK: db ( class -- object ) -HOOK: db ( class -- object ) -HOOK: db ( class -- object ) -HOOK: db ( tuple class -- object ) -HOOK: db ( tuple class -- tuple ) -TUPLE: query group order offset limit ; -HOOK: db ( tuple class query -- statement' ) -HOOK: db ( tuple class groups -- n ) - -HOOK: insert-tuple* db ( tuple statement -- ) - GENERIC: eval-generator ( singleton -- object ) : resulting-tuple ( exemplar-tuple row out-params -- tuple ) @@ -121,13 +130,14 @@ GENERIC: eval-generator ( singleton -- object ) [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ; : query ( tuple query -- tuples ) - [ dup dup class ] dip do-select ; + [ dup dup class ] dip make-query do-select ; + : select-tuples ( tuple -- tuples ) dup dup class do-select ; : select-tuple ( tuple -- tuple/f ) - dup dup class \ query new 1 >>limit do-select + dup dup class \ query new 1 >>limit make-query do-select [ f ] [ first ] if-empty ; : do-count ( exemplar-tuple statement -- tuples ) From 8eea1d13c2dd269ac6e7c8cc3fd8c017cbee4f0a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 23 Sep 2008 16:55:32 -0500 Subject: [PATCH 2/2] define-persistent checks that slots exist --- basis/db/tuples/tuples-tests.factor | 14 ++++++++++++-- basis/db/tuples/tuples.factor | 13 +++++++++++-- 2 files changed, 23 insertions(+), 4 deletions(-) diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 466d086fbe..45a51719f9 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -236,6 +236,17 @@ TUPLE: exam id name score ; exam boa ; : test-intervals ( -- ) + [ + exam "EXAM" + { + { "idd" "ID" +db-assigned-id+ } + { "named" "NAME" TEXT } + { "score" "SCORE" INTEGER } + } define-persistent + ] [ + seq>> { "idd" "named" } = + ] must-fail-with + exam "EXAM" { { "id" "ID" +db-assigned-id+ } @@ -507,9 +518,8 @@ string-encoding-test "STRING_ENCODING_TEST" { ! [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test ! [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test [ ] [ 10 [ random-exam insert-tuple ] times ] unit-test - [ ] [ ] unit-test + ! [ ] [ T{ exam { name "Kenny" } } >query ] unit-test ! [ ] [ query ] unit-test - ; : test-db ( -- ) diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 534b91b8fc..bff83b5b49 100755 --- a/basis/db/tuples/tuples.factor +++ b/basis/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 -destructors mirrors ; +destructors mirrors sets ; IN: db.tuples TUPLE: query tuple group order offset limit ; @@ -30,8 +30,17 @@ HOOK: make-query db ( tuple class query -- statement ) HOOK: insert-tuple* db ( tuple statement -- ) +ERROR: no-slots-named class seq ; +: check-columns ( class columns -- ) + tuck + [ [ first ] map ] + [ "slots" word-prop [ name>> ] map ] bi* diff + [ drop ] [ no-slots-named ] if-empty ; + : define-persistent ( class table columns -- ) - >r dupd "db-table" set-word-prop dup r> + pick dupd + check-columns + [ dupd "db-table" set-word-prop dup ] dip [ relation? ] partition swapd dupd [ spec>tuple ] with map "db-columns" set-word-prop