diff --git a/extra/db/db.factor b/extra/db/db.factor index d269d4654c..4fae508bb1 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -23,12 +23,12 @@ HOOK: db-close db ( handle -- ) db-handle db-close ] with-variable ; -TUPLE: statement handle sql slot-names bound? in-params out-params ; +TUPLE: statement handle sql bound? in-params out-params ; TUPLE: simple-statement ; TUPLE: prepared-statement ; HOOK: db ( str -- statement ) -HOOK: db ( str slot-names -- statement ) +HOOK: db ( str -- statement ) GENERIC: prepare-statement ( statement -- ) GENERIC: bind-statement* ( obj statement -- ) GENERIC: reset-statement ( statement -- ) diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 8cf7e79f53..97e32a411d 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -4,7 +4,7 @@ USING: arrays assocs alien alien.syntax continuations io kernel math math.parser namespaces prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges -combinators sequences.lib classes locals words ; +combinators sequences.lib classes locals words tools.walker ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty db user pass ; @@ -65,6 +65,7 @@ M: postgresql-result-set sql-type>factor-type ( obj type -- newobj ) } case ; M: postgresql-statement insert-statement ( statement -- id ) +break query-results [ 0 row-column ] with-disposal string>number ; M: postgresql-statement query-results ( query -- result-set ) @@ -104,10 +105,13 @@ M: postgresql-db ( sql -- statement ) { set-statement-sql } statement construct ; -M: postgresql-db ( pair -- statement ) - ?first2 - { set-statement-sql set-statement-slot-names } - statement construct ; +M: postgresql-db ( triple -- statement ) + ?first3 + { + set-statement-sql + set-statement-in-params + set-statement-out-params + } statement construct ; M: postgresql-db begin-transaction ( -- ) "BEGIN" sql-command ; @@ -166,6 +170,7 @@ SYMBOL: postgresql-counter : drop-function-sql ( specs table -- sql ) [ +break "drop function add_" % % "(" % remove-id @@ -215,8 +220,8 @@ M: postgresql-db drop-sql ( specs table -- seq ) ] postgresql-make ; M: postgresql-db insert-sql* ( specs table -- sql in-specs out-specs ) - over find-primary-key native-id? - [ insert-function-sql ] [ insert-table-sql ] if ; + dup class db-columns find-primary-key native-id? + [ insert-function-sql ] [ insert-table-sql ] if 3array ; M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs ) [ @@ -228,7 +233,7 @@ M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs ) " where " 0% find-primary-key dup sql-spec-column-name 0% " = " 0% bind% - ] postgresql-make ; + ] postgresql-make 3array ; M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs ) [ @@ -236,7 +241,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs ) " where " 0% find-primary-key dup sql-spec-column-name 0% " = " 0% bind% - ] postgresql-make ; + ] postgresql-make 3array ; : select-by-slots-sql ( tuple -- sql in-specs out-specs ) [ @@ -251,7 +256,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs ) [ ", " 0% ] [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave ";" 0% - ] postgresql-make ; + ] postgresql-make 3array ; ! : select-with-relations ( tuple -- sql in-specs out-specs ) @@ -259,7 +264,7 @@ M: postgresql-db select-sql ( tuple -- sql in-specs out-specs ) select-by-slots-sql ; M: postgresql-db tuple>params ( specs tuple -- obj ) - [ >r dup third swap first r> get-slot-named swap ] + [ >r dup sql-spec-type swap sql-spec-slot-name r> get-slot-named swap ] curry { } map>assoc ; M: postgresql-db type-table ( -- hash ) @@ -268,6 +273,7 @@ M: postgresql-db type-table ( -- hash ) { TEXT "text" } { VARCHAR "varchar" } { INTEGER "integer" } + { DOUBLE "real" } { TIMESTAMP "timestamp" } } ; @@ -278,12 +284,13 @@ M: postgresql-db create-type-table ( -- hash ) : postgresql-compound ( str n -- newstr ) over { - { "varchar" [ first number>string join-space ] } - { "references" - [ + { "default" [ first number>string join-space ] } + { "varchar" [ first number>string paren append ] } + { "references" [ first2 >r [ unparse join-space ] keep db-columns r> - swap [ sql-spec-slot-name = ] with find nip sql-spec-column-name paren append - ] } + swap [ sql-spec-slot-name = ] with find nip + sql-spec-column-name paren append + ] } [ "no compound found" 3array throw ] } case ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 6a3d7d03ae..648d8493dc 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -79,6 +79,7 @@ IN: db.sqlite.lib { VARCHAR [ sqlite-bind-text-by-name ] } { DOUBLE [ sqlite-bind-double-by-name ] } { TIMESTAMP [ sqlite-bind-double-by-name ] } + { +native-id+ [ sqlite-bind-int-by-name ] } ! { NULL [ sqlite-bind-null-by-name ] } [ no-sql-type ] } case ; diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 748b2bbf68..249856e8bc 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -4,7 +4,7 @@ USING: alien arrays assocs classes compiler db hashtables io.files kernel math math.parser namespaces prettyprint sequences strings tuples alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples -words combinators.lib db.types combinators ; +words combinators.lib db.types combinators tools.walker ; IN: db.sqlite TUPLE: sqlite-db path ; @@ -99,7 +99,7 @@ M: sqlite-db create-sql ( specs table -- sql ) M: sqlite-db drop-sql ( specs table -- sql ) [ - "drop table " % % ";" % + "drop table " % % ";" % drop ] "" make ; M: sqlite-db insert-sql* ( specs table -- sql ) @@ -161,9 +161,9 @@ M: sqlite-db select-sql ( tuple -- sql ) M: sqlite-db tuple>params ( specs tuple -- obj ) [ - >r [ second ":" swap append ] keep r> - dupd >r first r> get-slot-named swap - third 3array + >r [ sql-spec-column-name ":" swap append ] keep r> + dupd >r sql-spec-slot-name r> get-slot-named swap + sql-spec-type 3array ] curry map ; M: sqlite-db modifier-table ( -- hashtable ) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 742702cebf..5a5df7c185 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -2,19 +2,18 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel tools.test db db.sqlite db.tuples db.types continuations namespaces db.postgresql math -prettyprint ; -! tools.time ; +prettyprint tools.walker ; IN: temporary -TUPLE: person the-id the-name the-number real ; +TUPLE: person the-id the-name the-number the-real ; : ( name age real -- person ) { set-person-the-name set-person-the-number - set-person-real + set-person-the-real } person construct ; -: ( id name number real -- obj ) +: ( id name number the-real -- obj ) [ set-person-the-id ] keep ; SYMBOL: the-person @@ -31,8 +30,10 @@ SYMBOL: the-person [ ] [ the-person get update-tuple ] unit-test + ! T{ person f f f 200 f } select-tuples + [ ] [ the-person get delete-tuple ] unit-test - ; ! 1 [ ] [ person drop-table ] unit-test ; + [ ] [ person drop-table ] unit-test ; : test-sqlite ( -- ) "tuples-test.db" resource-path [ @@ -49,20 +50,20 @@ person "PERSON" { "the-id" "ID" +native-id+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-number" "AGE" INTEGER { +default+ 0 } } - { "real" "REAL" DOUBLE { +default+ 0.3 } } + { "the-real" "REAL" DOUBLE { +default+ 0.3 } } } define-persistent "billy" 10 3.14 the-person set -test-sqlite -! test-postgresql +! test-sqlite +test-postgresql ! person "PERSON" ! { ! { "the-id" "ID" INTEGER +assigned-id+ } ! { "the-name" "NAME" { VARCHAR 256 } +not-null+ } ! { "the-number" "AGE" INTEGER { +default+ 0 } } - ! { "real" "REAL" DOUBLE { +default+ 0.3 } } + ! { "the-real" "REAL" DOUBLE { +default+ 0.3 } } ! } define-persistent ! 1 "billy" 20 6.28 the-person set @@ -95,11 +96,11 @@ annotation "ANNOTATION" { "contents" "CONTENTS" TEXT } } define-persistent -"localhost" "postgres" "" "factor-test" [ - [ paste drop-table ] [ drop ] recover - [ annotation drop-table ] [ drop ] recover - [ paste drop-table ] [ drop ] recover - [ annotation drop-table ] [ drop ] recover - paste create-table - annotation create-table -] with-db +! "localhost" "postgres" "" "factor-test" [ + ! [ paste drop-table ] [ drop ] recover + ! [ annotation drop-table ] [ drop ] recover + ! [ paste drop-table ] [ drop ] recover + ! [ annotation drop-table ] [ drop ] recover + ! [ ] [ paste create-table ] unit-test + ! [ ] [ annotation create-table ] unit-test +! ] with-db diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 11926b832d..7a95cc8e0e 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -3,7 +3,7 @@ USING: arrays assocs classes db kernel namespaces tuples words sequences slots slots.private math math.parser io prettyprint db.types continuations -mirrors sequences.lib ; +mirrors sequences.lib tools.walker ; IN: db.tuples : db-table ( class -- obj ) "db-table" word-prop ; @@ -33,7 +33,7 @@ TUPLE: no-slot-named ; dup class primary-key-spec get-slot-named ; : set-primary-key ( obj tuple -- ) - [ class primary-key-spec first ] keep + [ class primary-key-spec sql-spec-slot-name ] keep set-slot-named ; : cache-statement ( columns class assoc quot -- statement ) @@ -92,7 +92,7 @@ HOOK: tuple>params db ( columns tuple -- obj ) : delete-tuple ( tuple -- ) [ [ primary-key? ] subset ] [ delete-sql ] do-tuple-statement ; -: select-tuple ( tuple -- ) +: select-tuples ( tuple -- ) [ select-sql ] keep do-query ; : persist ( tuple -- ) diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 77c704d1c9..a99ccc09f7 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -2,7 +2,7 @@ ! 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 ; +words namespaces tools.walker ; IN: db.types TUPLE: sql-spec slot-name column-name type modifiers primary-key ; @@ -12,15 +12,18 @@ SYMBOL: +native-id+ ! +assigned-id+ can only be a modifier SYMBOL: +assigned-id+ -: primary-key? ( obj -- ? ) +: (primary-key?) ( obj -- ? ) { +native-id+ +assigned-id+ } member? ; +: primary-key? ( spec -- ? ) + sql-spec-primary-key (primary-key?) ; + : normalize-spec ( spec -- ) - dup sql-spec-type dup primary-key? [ + dup sql-spec-type dup (primary-key?) [ swap set-sql-spec-primary-key ] [ drop dup sql-spec-modifiers [ - primary-key? + (primary-key?) ] deep-find [ swap set-sql-spec-primary-key ] [ drop ] if* ] if ;