diff --git a/extra/db/db.factor b/extra/db/db.factor index 42a2b4bcb0..237d8698a6 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -35,7 +35,6 @@ HOOK: db-close db ( handle -- ) handle>> db-close ] with-variable ; -! TUPLE: sql sql in-params out-params ; TUPLE: statement handle sql in-params out-params bind-params bound? type ; TUPLE: simple-statement < statement ; TUPLE: prepared-statement < statement ; diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index 436d701803..8b0026b6e5 100755 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -154,7 +154,7 @@ M: postgresql-malloc-destructor dispose ( obj -- ) : postgresql-column-typed ( handle row column type -- obj ) dup array? [ first ] when { - { +native-id+ [ pq-get-number ] } + { +db-assigned-id+ [ pq-get-number ] } { +random-id+ [ pq-get-number ] } { INTEGER [ pq-get-number ] } { BIG-INTEGER [ pq-get-number ] } diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 687146af11..e728f2f011 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -6,6 +6,7 @@ sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges combinators sequences.lib classes locals words tools.walker namespaces.lib accessors random db.queries ; +USE: tools.walker IN: db.postgresql TUPLE: postgresql-db < db @@ -48,7 +49,7 @@ M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- obj ) nip value>> ; M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- obj ) - nip singleton>> eval-generator ; + nip generator-singleton>> eval-generator ; M: postgresql-statement bind-tuple ( tuple statement -- ) tuck in-params>> @@ -158,7 +159,7 @@ M: postgresql-db bind# ( spec obj -- ) M: postgresql-db create-sql-statement ( class -- seq ) [ [ create-table-sql , ] keep - dup db-columns find-primary-key native-id? + dup db-columns find-primary-key db-assigned-id-spec? [ create-function-sql , ] [ drop ] if ] { } make ; @@ -179,11 +180,11 @@ M: postgresql-db create-sql-statement ( class -- seq ) M: postgresql-db drop-sql-statement ( class -- seq ) [ [ drop-table-sql , ] keep - dup db-columns find-primary-key native-id? + dup db-columns find-primary-key db-assigned-id-spec? [ drop-function-sql , ] [ drop ] if ] { } make ; -M: postgresql-db ( class -- statement ) +M: postgresql-db ( class -- statement ) [ "select add_" 0% 0% "(" 0% @@ -193,7 +194,7 @@ M: postgresql-db ( class -- statement ) ");" 0% ] query-make ; -M: postgresql-db ( class -- statement ) +M: postgresql-db ( class -- statement ) [ "insert into " 0% 0% "(" 0% @@ -219,8 +220,8 @@ M: postgresql-db insert-tuple* ( tuple statement -- ) M: postgresql-db persistent-table ( -- hashtable ) H{ - { +native-id+ { "integer" "serial primary key" f } } - { +assigned-id+ { f f "primary key" } } + { +db-assigned-id+ { "integer" "serial primary key" f } } + { +user-assigned-id+ { f f "primary key" } } { +random-id+ { "bigint" "bigint primary key" f } } { TEXT { "text" "text" f } } { VARCHAR { "varchar" "varchar" f } } diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 9f29b9e6fb..f25ec12d1b 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -106,7 +106,7 @@ IN: db.sqlite.lib object>bytes sqlite-bind-blob-by-name ] } - { +native-id+ [ sqlite-bind-int-by-name ] } + { +db-assigned-id+ [ sqlite-bind-int-by-name ] } { +random-id+ [ sqlite-bind-int64-by-name ] } { NULL [ sqlite-bind-null-by-name ] } [ no-sql-type ] @@ -132,7 +132,7 @@ IN: db.sqlite.lib : sqlite-column-typed ( handle index type -- obj ) dup array? [ first ] when { - { +native-id+ [ sqlite3_column_int64 ] } + { +db-assigned-id+ [ sqlite3_column_int64 ] } { +random-id+ [ sqlite3-column-uint64 ] } { INTEGER [ sqlite3_column_int ] } { BIG-INTEGER [ sqlite3_column_int64 ] } diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 2407613eca..6297f89d8e 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -79,7 +79,7 @@ M: literal-bind sqlite-bind-conversion ( tuple literal-bind -- array ) ; M: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array ) - nip [ key>> ] [ singleton>> eval-generator ] [ type>> ] tri + nip [ key>> ] [ generator-singleton>> eval-generator ] [ type>> ] tri ; M: sqlite-statement bind-tuple ( tuple statement -- ) @@ -129,11 +129,11 @@ M: sqlite-db create-sql-statement ( class -- statement ) M: sqlite-db drop-sql-statement ( class -- statement ) [ "drop table " 0% 0% ";" 0% drop ] query-make ; -M: sqlite-db ( tuple -- statement ) +M: sqlite-db ( tuple -- statement ) [ "insert into " 0% 0% "(" 0% - maybe-remove-id + remove-db-assigned-id dup [ ", " 0% ] [ column-name>> 0% ] interleave ") values(" 0% [ ", " 0% ] [ @@ -149,8 +149,8 @@ M: sqlite-db ( tuple -- statement ) ");" 0% ] query-make ; -M: sqlite-db ( tuple -- statement ) - ; +M: sqlite-db ( tuple -- statement ) + ; M: sqlite-db bind# ( spec obj -- ) >r @@ -163,8 +163,8 @@ M: sqlite-db bind% ( spec -- ) M: sqlite-db persistent-table ( -- assoc ) H{ - { +native-id+ { "integer primary key" "integer primary key" "primary key" } } - { +assigned-id+ { f f "primary key" } } + { +db-assigned-id+ { "integer primary key" "integer primary key" "primary key" } } + { +user-assigned-id+ { f f "primary key" } } { +random-id+ { "integer primary key" "integer primary key" "primary key" } } { INTEGER { "integer" "integer" "primary key" } } { BIG-INTEGER { "bigint" "bigint" } } diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 066bf1ce96..7b22a3c594 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -21,7 +21,7 @@ ts date time blob factor-blob ; set-person-factor-blob } person construct ; -: ( id name age real ts date time blob factor-blob -- person ) +: ( id name age real ts date time blob factor-blob -- person ) [ set-person-the-id ] keep ; SYMBOL: person1 @@ -106,10 +106,10 @@ SYMBOL: person4 [ ] [ person drop-table ] unit-test ; -: native-person-schema ( -- ) +: db-assigned-person-schema ( -- ) person "PERSON" { - { "the-id" "ID" +native-id+ } + { "the-id" "ID" +db-assigned-id+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-number" "AGE" INTEGER { +default+ 0 } } { "the-real" "REAL" DOUBLE { +default+ 0.3 } } @@ -132,10 +132,10 @@ SYMBOL: person4 T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } f H{ { 1 2 } { 3 4 } { 5 "lol" } } person4 set ; -: assigned-person-schema ( -- ) +: user-assigned-person-schema ( -- ) person "PERSON" { - { "the-id" "ID" INTEGER +assigned-id+ } + { "the-id" "ID" INTEGER +user-assigned-id+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-number" "AGE" INTEGER { +default+ 0 } } { "the-real" "REAL" DOUBLE { +default+ 0.3 } } @@ -145,27 +145,27 @@ SYMBOL: person4 { "blob" "B" BLOB } { "factor-blob" "FB" FACTOR-BLOB } } define-persistent - 1 "billy" 10 3.14 f f f f f person1 set - 2 "johnny" 10 3.14 f f f f f person2 set + 1 "billy" 10 3.14 f f f f f person1 set + 2 "johnny" 10 3.14 f f f f f person2 set 3 "teddy" 10 3.14 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } B{ 115 116 111 114 101 105 110 97 98 108 111 98 } - f person3 set + f person3 set 4 "eddie" 10 3.14 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } - f H{ { 1 2 } { 3 4 } { 5 "lol" } } person4 set ; + f H{ { 1 2 } { 3 4 } { 5 "lol" } } person4 set ; TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: annotation n paste-id summary author mode contents ; -: native-paste-schema ( -- ) +: db-assigned-paste-schema ( -- ) paste "PASTE" { - { "n" "ID" +native-id+ } + { "n" "ID" +db-assigned-id+ } { "summary" "SUMMARY" TEXT } { "author" "AUTHOR" TEXT } { "channel" "CHANNEL" TEXT } @@ -177,7 +177,7 @@ TUPLE: annotation n paste-id summary author mode contents ; annotation "ANNOTATION" { - { "n" "ID" +native-id+ } + { "n" "ID" +db-assigned-id+ } { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } } { "summary" "SUMMARY" TEXT } { "author" "AUTHOR" TEXT } @@ -210,7 +210,7 @@ TUPLE: serialize-me id data ; : test-serialize ( -- ) serialize-me "SERIALIZED" { - { "id" "ID" +native-id+ } + { "id" "ID" +db-assigned-id+ } { "data" "DATA" FACTOR-BLOB } } define-persistent [ serialize-me drop-table ] [ drop ] recover @@ -226,7 +226,7 @@ TUPLE: exam id name score ; : test-intervals ( -- ) exam "EXAM" { - { "id" "ID" +native-id+ } + { "id" "ID" +db-assigned-id+ } { "name" "NAME" TEXT } { "score" "SCORE" INTEGER } } define-persistent @@ -304,7 +304,7 @@ TUPLE: bignum-test id m n o ; : test-bignum bignum-test "BIGNUM_TEST" { - { "id" "ID" +native-id+ } + { "id" "ID" +db-assigned-id+ } { "m" "M" BIG-INTEGER } { "n" "N" UNSIGNED-BIG-INTEGER } { "o" "O" SIGNED-BIG-INTEGER } @@ -345,17 +345,17 @@ C: secret T{ secret } select-tuples length 3 = ] unit-test ; -[ native-person-schema test-tuples ] test-sqlite -[ assigned-person-schema test-tuples ] test-sqlite -[ assigned-person-schema test-repeated-insert ] test-sqlite +[ db-assigned-person-schema test-tuples ] test-sqlite +[ user-assigned-person-schema test-tuples ] test-sqlite +[ user-assigned-person-schema test-repeated-insert ] test-sqlite [ test-bignum ] test-sqlite [ test-serialize ] test-sqlite [ test-intervals ] test-sqlite [ test-random-id ] test-sqlite -[ native-person-schema test-tuples ] test-postgresql -[ assigned-person-schema test-tuples ] test-postgresql -[ assigned-person-schema test-repeated-insert ] test-postgresql +[ db-assigned-person-schema test-tuples ] test-postgresql +[ user-assigned-person-schema test-tuples ] test-postgresql +[ user-assigned-person-schema test-repeated-insert ] test-postgresql [ test-bignum ] test-postgresql [ test-serialize ] test-postgresql [ test-intervals ] test-postgresql diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index ce2236d23b..e14b4f79d4 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -37,8 +37,8 @@ SYMBOL: sql-counter HOOK: create-sql-statement db ( class -- obj ) HOOK: drop-sql-statement db ( class -- obj ) -HOOK: db ( class -- obj ) -HOOK: db ( class -- obj ) +HOOK: db ( class -- obj ) +HOOK: db ( class -- obj ) HOOK: db ( class -- obj ) HOOK: db ( class -- obj ) @@ -65,7 +65,7 @@ SINGLETON: retryable [ bind-params>> ] [ in-params>> ] bi [ dup generator-bind? [ - singleton>> eval-generator >>value + generator-singleton>> eval-generator >>value ] [ drop ] if @@ -119,19 +119,19 @@ M: retryable execute-statement* ( statement type -- ) [ execute-statement ] with-disposals ] [ create-table ] bi ; -: insert-native ( tuple -- ) +: insert-db-assigned-statement ( tuple -- ) dup class - db get db-insert-statements [ ] cache + db get db-insert-statements [ ] cache [ bind-tuple ] 2keep insert-tuple* ; -: insert-nonnative ( tuple -- ) +: insert-user-assigned-statement ( tuple -- ) dup class - db get db-insert-statements [ ] cache + db get db-insert-statements [ ] cache [ bind-tuple ] keep execute-statement ; : insert-tuple ( tuple -- ) - dup class db-columns find-primary-key nonnative-id? - [ insert-nonnative ] [ insert-native ] if ; + dup class db-columns find-primary-key db-assigned-id-spec? + [ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ; : update-tuple ( tuple -- ) dup class diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 887293ef94..e11d246643 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -15,18 +15,17 @@ TUPLE: sql-spec class slot-name column-name type primary-key modifiers ; TUPLE: literal-bind key type value ; C: literal-bind -TUPLE: generator-bind key singleton type ; +TUPLE: generator-bind key generator-singleton type ; C: generator-bind SINGLETON: random-id-generator TUPLE: low-level-binding value ; C: low-level-binding -SINGLETON: +native-id+ -SINGLETON: +assigned-id+ +SINGLETON: +db-assigned-id+ +SINGLETON: +user-assigned-id+ SINGLETON: +random-id+ -UNION: +primary-key+ +native-id+ +assigned-id+ +random-id+ ; -UNION: +nonnative-id+ +random-id+ +assigned-id+ ; +UNION: +primary-key+ +db-assigned-id+ +user-assigned-id+ +random-id+ ; SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ +foreign-id+ +has-many+ ; @@ -43,11 +42,11 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ : primary-key? ( spec -- ? ) primary-key>> +primary-key+? ; -: native-id? ( spec -- ? ) - primary-key>> +native-id+? ; +: db-assigned-id-spec? ( spec -- ? ) + primary-key>> +db-assigned-id+? ; -: nonnative-id? ( spec -- ? ) - primary-key>> +nonnative-id+? ; +: assigned-id-spec? ( spec -- ? ) + primary-key>> +user-assigned-id+? ; : normalize-spec ( spec -- ) dup type>> dup +primary-key+? [ @@ -82,8 +81,8 @@ FACTOR-BLOB NULL ; : number>string* ( n/str -- str ) dup number? [ number>string ] when ; -: maybe-remove-id ( specs -- obj ) - [ +native-id+? not ] filter ; +: remove-db-assigned-id ( specs -- obj ) + [ +db-assigned-id+? not ] filter ; : remove-relations ( specs -- newcolumns ) [ relation? not ] filter ;