refactor db: native-id -> db-assigned-id

assigned-id -> user-assigned-id
db4
Doug Coleman 2008-04-28 16:48:55 -05:00
parent 1dbc37e0cd
commit 618e10a6b2
8 changed files with 58 additions and 59 deletions

View File

@ -35,7 +35,6 @@ HOOK: db-close db ( handle -- )
handle>> db-close handle>> db-close
] with-variable ; ] with-variable ;
! TUPLE: sql sql in-params out-params ;
TUPLE: statement handle sql in-params out-params bind-params bound? type ; TUPLE: statement handle sql in-params out-params bind-params bound? type ;
TUPLE: simple-statement < statement ; TUPLE: simple-statement < statement ;
TUPLE: prepared-statement < statement ; TUPLE: prepared-statement < statement ;

View File

@ -154,7 +154,7 @@ M: postgresql-malloc-destructor dispose ( obj -- )
: postgresql-column-typed ( handle row column type -- obj ) : postgresql-column-typed ( handle row column type -- obj )
dup array? [ first ] when dup array? [ first ] when
{ {
{ +native-id+ [ pq-get-number ] } { +db-assigned-id+ [ pq-get-number ] }
{ +random-id+ [ pq-get-number ] } { +random-id+ [ pq-get-number ] }
{ INTEGER [ pq-get-number ] } { INTEGER [ pq-get-number ] }
{ BIG-INTEGER [ pq-get-number ] } { BIG-INTEGER [ pq-get-number ] }

View File

@ -6,6 +6,7 @@ sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges db.tuples db.types tools.annotations math.ranges
combinators sequences.lib classes locals words tools.walker combinators sequences.lib classes locals words tools.walker
namespaces.lib accessors random db.queries ; namespaces.lib accessors random db.queries ;
USE: tools.walker
IN: db.postgresql IN: db.postgresql
TUPLE: postgresql-db < db TUPLE: postgresql-db < db
@ -48,7 +49,7 @@ M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- obj )
nip value>> <low-level-binding> ; nip value>> <low-level-binding> ;
M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- obj ) M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- obj )
nip singleton>> eval-generator <low-level-binding> ; nip generator-singleton>> eval-generator <low-level-binding> ;
M: postgresql-statement bind-tuple ( tuple statement -- ) M: postgresql-statement bind-tuple ( tuple statement -- )
tuck in-params>> tuck in-params>>
@ -158,7 +159,7 @@ M: postgresql-db bind# ( spec obj -- )
M: postgresql-db create-sql-statement ( class -- seq ) M: postgresql-db create-sql-statement ( class -- seq )
[ [
[ create-table-sql , ] keep [ 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 [ create-function-sql , ] [ drop ] if
] { } make ; ] { } make ;
@ -179,11 +180,11 @@ M: postgresql-db create-sql-statement ( class -- seq )
M: postgresql-db drop-sql-statement ( class -- seq ) M: postgresql-db drop-sql-statement ( class -- seq )
[ [
[ drop-table-sql , ] keep [ 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 [ drop-function-sql , ] [ drop ] if
] { } make ; ] { } make ;
M: postgresql-db <insert-native-statement> ( class -- statement ) M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
[ [
"select add_" 0% 0% "select add_" 0% 0%
"(" 0% "(" 0%
@ -193,7 +194,7 @@ M: postgresql-db <insert-native-statement> ( class -- statement )
");" 0% ");" 0%
] query-make ; ] query-make ;
M: postgresql-db <insert-nonnative-statement> ( class -- statement ) M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
[ [
"insert into " 0% 0% "insert into " 0% 0%
"(" 0% "(" 0%
@ -219,8 +220,8 @@ M: postgresql-db insert-tuple* ( tuple statement -- )
M: postgresql-db persistent-table ( -- hashtable ) M: postgresql-db persistent-table ( -- hashtable )
H{ H{
{ +native-id+ { "integer" "serial primary key" f } } { +db-assigned-id+ { "integer" "serial primary key" f } }
{ +assigned-id+ { f f "primary key" } } { +user-assigned-id+ { f f "primary key" } }
{ +random-id+ { "bigint" "bigint primary key" f } } { +random-id+ { "bigint" "bigint primary key" f } }
{ TEXT { "text" "text" f } } { TEXT { "text" "text" f } }
{ VARCHAR { "varchar" "varchar" f } } { VARCHAR { "varchar" "varchar" f } }

View File

@ -106,7 +106,7 @@ IN: db.sqlite.lib
object>bytes object>bytes
sqlite-bind-blob-by-name 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 ] } { +random-id+ [ sqlite-bind-int64-by-name ] }
{ NULL [ sqlite-bind-null-by-name ] } { NULL [ sqlite-bind-null-by-name ] }
[ no-sql-type ] [ no-sql-type ]
@ -132,7 +132,7 @@ IN: db.sqlite.lib
: sqlite-column-typed ( handle index type -- obj ) : sqlite-column-typed ( handle index type -- obj )
dup array? [ first ] when dup array? [ first ] when
{ {
{ +native-id+ [ sqlite3_column_int64 ] } { +db-assigned-id+ [ sqlite3_column_int64 ] }
{ +random-id+ [ sqlite3-column-uint64 ] } { +random-id+ [ sqlite3-column-uint64 ] }
{ INTEGER [ sqlite3_column_int ] } { INTEGER [ sqlite3_column_int ] }
{ BIG-INTEGER [ sqlite3_column_int64 ] } { BIG-INTEGER [ sqlite3_column_int64 ] }

View File

@ -79,7 +79,7 @@ M: literal-bind sqlite-bind-conversion ( tuple literal-bind -- array )
<sqlite-low-level-binding> ; <sqlite-low-level-binding> ;
M: generator-bind sqlite-bind-conversion ( tuple generate-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
<sqlite-low-level-binding> ; <sqlite-low-level-binding> ;
M: sqlite-statement bind-tuple ( tuple statement -- ) 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 ) M: sqlite-db drop-sql-statement ( class -- statement )
[ "drop table " 0% 0% ";" 0% drop ] query-make ; [ "drop table " 0% 0% ";" 0% drop ] query-make ;
M: sqlite-db <insert-native-statement> ( tuple -- statement ) M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
[ [
"insert into " 0% 0% "insert into " 0% 0%
"(" 0% "(" 0%
maybe-remove-id remove-db-assigned-id
dup [ ", " 0% ] [ column-name>> 0% ] interleave dup [ ", " 0% ] [ column-name>> 0% ] interleave
") values(" 0% ") values(" 0%
[ ", " 0% ] [ [ ", " 0% ] [
@ -149,8 +149,8 @@ M: sqlite-db <insert-native-statement> ( tuple -- statement )
");" 0% ");" 0%
] query-make ; ] query-make ;
M: sqlite-db <insert-nonnative-statement> ( tuple -- statement ) M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
<insert-native-statement> ; <insert-db-assigned-statement> ;
M: sqlite-db bind# ( spec obj -- ) M: sqlite-db bind# ( spec obj -- )
>r >r
@ -163,8 +163,8 @@ M: sqlite-db bind% ( spec -- )
M: sqlite-db persistent-table ( -- assoc ) M: sqlite-db persistent-table ( -- assoc )
H{ H{
{ +native-id+ { "integer primary key" "integer primary key" "primary key" } } { +db-assigned-id+ { "integer primary key" "integer primary key" "primary key" } }
{ +assigned-id+ { f f "primary key" } } { +user-assigned-id+ { f f "primary key" } }
{ +random-id+ { "integer primary key" "integer primary key" "primary key" } } { +random-id+ { "integer primary key" "integer primary key" "primary key" } }
{ INTEGER { "integer" "integer" "primary key" } } { INTEGER { "integer" "integer" "primary key" } }
{ BIG-INTEGER { "bigint" "bigint" } } { BIG-INTEGER { "bigint" "bigint" } }

View File

@ -21,7 +21,7 @@ ts date time blob factor-blob ;
set-person-factor-blob set-person-factor-blob
} person construct ; } person construct ;
: <assigned-person> ( id name age real ts date time blob factor-blob -- person ) : <user-assigned-person> ( id name age real ts date time blob factor-blob -- person )
<person> [ set-person-the-id ] keep ; <person> [ set-person-the-id ] keep ;
SYMBOL: person1 SYMBOL: person1
@ -106,10 +106,10 @@ SYMBOL: person4
[ ] [ person drop-table ] unit-test ; [ ] [ person drop-table ] unit-test ;
: native-person-schema ( -- ) : db-assigned-person-schema ( -- )
person "PERSON" person "PERSON"
{ {
{ "the-id" "ID" +native-id+ } { "the-id" "ID" +db-assigned-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } } { "the-number" "AGE" INTEGER { +default+ 0 } }
{ "the-real" "REAL" DOUBLE { +default+ 0.3 } } { "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 } } 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" } } <person> person4 set ; f H{ { 1 2 } { 3 4 } { 5 "lol" } } <person> person4 set ;
: assigned-person-schema ( -- ) : user-assigned-person-schema ( -- )
person "PERSON" person "PERSON"
{ {
{ "the-id" "ID" INTEGER +assigned-id+ } { "the-id" "ID" INTEGER +user-assigned-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } } { "the-number" "AGE" INTEGER { +default+ 0 } }
{ "the-real" "REAL" DOUBLE { +default+ 0.3 } } { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
@ -145,27 +145,27 @@ SYMBOL: person4
{ "blob" "B" BLOB } { "blob" "B" BLOB }
{ "factor-blob" "FB" FACTOR-BLOB } { "factor-blob" "FB" FACTOR-BLOB }
} define-persistent } define-persistent
1 "billy" 10 3.14 f f f f f <assigned-person> person1 set 1 "billy" 10 3.14 f f f f f <user-assigned-person> person1 set
2 "johnny" 10 3.14 f f f f f <assigned-person> person2 set 2 "johnny" 10 3.14 f f f f f <user-assigned-person> person2 set
3 "teddy" 10 3.14 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 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 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 } } 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 } B{ 115 116 111 114 101 105 110 97 98 108 111 98 }
f <assigned-person> person3 set f <user-assigned-person> person3 set
4 "eddie" 10 3.14 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 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 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 } } 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" } } <assigned-person> person4 set ; f H{ { 1 2 } { 3 4 } { 5 "lol" } } <user-assigned-person> person4 set ;
TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: paste n summary author channel mode contents timestamp annotations ;
TUPLE: annotation n paste-id summary author mode contents ; TUPLE: annotation n paste-id summary author mode contents ;
: native-paste-schema ( -- ) : db-assigned-paste-schema ( -- )
paste "PASTE" paste "PASTE"
{ {
{ "n" "ID" +native-id+ } { "n" "ID" +db-assigned-id+ }
{ "summary" "SUMMARY" TEXT } { "summary" "SUMMARY" TEXT }
{ "author" "AUTHOR" TEXT } { "author" "AUTHOR" TEXT }
{ "channel" "CHANNEL" TEXT } { "channel" "CHANNEL" TEXT }
@ -177,7 +177,7 @@ TUPLE: annotation n paste-id summary author mode contents ;
annotation "ANNOTATION" annotation "ANNOTATION"
{ {
{ "n" "ID" +native-id+ } { "n" "ID" +db-assigned-id+ }
{ "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } } { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
{ "summary" "SUMMARY" TEXT } { "summary" "SUMMARY" TEXT }
{ "author" "AUTHOR" TEXT } { "author" "AUTHOR" TEXT }
@ -210,7 +210,7 @@ TUPLE: serialize-me id data ;
: test-serialize ( -- ) : test-serialize ( -- )
serialize-me "SERIALIZED" serialize-me "SERIALIZED"
{ {
{ "id" "ID" +native-id+ } { "id" "ID" +db-assigned-id+ }
{ "data" "DATA" FACTOR-BLOB } { "data" "DATA" FACTOR-BLOB }
} define-persistent } define-persistent
[ serialize-me drop-table ] [ drop ] recover [ serialize-me drop-table ] [ drop ] recover
@ -226,7 +226,7 @@ TUPLE: exam id name score ;
: test-intervals ( -- ) : test-intervals ( -- )
exam "EXAM" exam "EXAM"
{ {
{ "id" "ID" +native-id+ } { "id" "ID" +db-assigned-id+ }
{ "name" "NAME" TEXT } { "name" "NAME" TEXT }
{ "score" "SCORE" INTEGER } { "score" "SCORE" INTEGER }
} define-persistent } define-persistent
@ -304,7 +304,7 @@ TUPLE: bignum-test id m n o ;
: test-bignum : test-bignum
bignum-test "BIGNUM_TEST" bignum-test "BIGNUM_TEST"
{ {
{ "id" "ID" +native-id+ } { "id" "ID" +db-assigned-id+ }
{ "m" "M" BIG-INTEGER } { "m" "M" BIG-INTEGER }
{ "n" "N" UNSIGNED-BIG-INTEGER } { "n" "N" UNSIGNED-BIG-INTEGER }
{ "o" "O" SIGNED-BIG-INTEGER } { "o" "O" SIGNED-BIG-INTEGER }
@ -345,17 +345,17 @@ C: <secret> secret
T{ secret } select-tuples length 3 = T{ secret } select-tuples length 3 =
] unit-test ; ] unit-test ;
[ native-person-schema test-tuples ] test-sqlite [ db-assigned-person-schema test-tuples ] test-sqlite
[ assigned-person-schema test-tuples ] test-sqlite [ user-assigned-person-schema test-tuples ] test-sqlite
[ assigned-person-schema test-repeated-insert ] test-sqlite [ user-assigned-person-schema test-repeated-insert ] test-sqlite
[ test-bignum ] test-sqlite [ test-bignum ] test-sqlite
[ test-serialize ] test-sqlite [ test-serialize ] test-sqlite
[ test-intervals ] test-sqlite [ test-intervals ] test-sqlite
[ test-random-id ] test-sqlite [ test-random-id ] test-sqlite
[ native-person-schema test-tuples ] test-postgresql [ db-assigned-person-schema test-tuples ] test-postgresql
[ assigned-person-schema test-tuples ] test-postgresql [ user-assigned-person-schema test-tuples ] test-postgresql
[ assigned-person-schema test-repeated-insert ] test-postgresql [ user-assigned-person-schema test-repeated-insert ] test-postgresql
[ test-bignum ] test-postgresql [ test-bignum ] test-postgresql
[ test-serialize ] test-postgresql [ test-serialize ] test-postgresql
[ test-intervals ] test-postgresql [ test-intervals ] test-postgresql

View File

@ -37,8 +37,8 @@ SYMBOL: sql-counter
HOOK: create-sql-statement db ( class -- obj ) HOOK: create-sql-statement db ( class -- obj )
HOOK: drop-sql-statement db ( class -- obj ) HOOK: drop-sql-statement db ( class -- obj )
HOOK: <insert-native-statement> db ( class -- obj ) HOOK: <insert-db-assigned-statement> db ( class -- obj )
HOOK: <insert-nonnative-statement> db ( class -- obj ) HOOK: <insert-user-assigned-statement> db ( class -- obj )
HOOK: <update-tuple-statement> db ( class -- obj ) HOOK: <update-tuple-statement> db ( class -- obj )
HOOK: <update-tuples-statement> db ( class -- obj ) HOOK: <update-tuples-statement> db ( class -- obj )
@ -65,7 +65,7 @@ SINGLETON: retryable
[ bind-params>> ] [ in-params>> ] bi [ bind-params>> ] [ in-params>> ] bi
[ [
dup generator-bind? [ dup generator-bind? [
singleton>> eval-generator >>value generator-singleton>> eval-generator >>value
] [ ] [
drop drop
] if ] if
@ -119,19 +119,19 @@ M: retryable execute-statement* ( statement type -- )
[ execute-statement ] with-disposals [ execute-statement ] with-disposals
] [ create-table ] bi ; ] [ create-table ] bi ;
: insert-native ( tuple -- ) : insert-db-assigned-statement ( tuple -- )
dup class dup class
db get db-insert-statements [ <insert-native-statement> ] cache db get db-insert-statements [ <insert-db-assigned-statement> ] cache
[ bind-tuple ] 2keep insert-tuple* ; [ bind-tuple ] 2keep insert-tuple* ;
: insert-nonnative ( tuple -- ) : insert-user-assigned-statement ( tuple -- )
dup class dup class
db get db-insert-statements [ <insert-nonnative-statement> ] cache db get db-insert-statements [ <insert-user-assigned-statement> ] cache
[ bind-tuple ] keep execute-statement ; [ bind-tuple ] keep execute-statement ;
: insert-tuple ( tuple -- ) : insert-tuple ( tuple -- )
dup class db-columns find-primary-key nonnative-id? dup class db-columns find-primary-key db-assigned-id-spec?
[ insert-nonnative ] [ insert-native ] if ; [ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ;
: update-tuple ( tuple -- ) : update-tuple ( tuple -- )
dup class dup class

View File

@ -15,18 +15,17 @@ TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
TUPLE: literal-bind key type value ; TUPLE: literal-bind key type value ;
C: <literal-bind> literal-bind C: <literal-bind> literal-bind
TUPLE: generator-bind key singleton type ; TUPLE: generator-bind key generator-singleton type ;
C: <generator-bind> generator-bind C: <generator-bind> generator-bind
SINGLETON: random-id-generator SINGLETON: random-id-generator
TUPLE: low-level-binding value ; TUPLE: low-level-binding value ;
C: <low-level-binding> low-level-binding C: <low-level-binding> low-level-binding
SINGLETON: +native-id+ SINGLETON: +db-assigned-id+
SINGLETON: +assigned-id+ SINGLETON: +user-assigned-id+
SINGLETON: +random-id+ SINGLETON: +random-id+
UNION: +primary-key+ +native-id+ +assigned-id+ +random-id+ ; UNION: +primary-key+ +db-assigned-id+ +user-assigned-id+ +random-id+ ;
UNION: +nonnative-id+ +random-id+ +assigned-id+ ;
SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
+foreign-id+ +has-many+ ; +foreign-id+ +has-many+ ;
@ -43,11 +42,11 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
: primary-key? ( spec -- ? ) : primary-key? ( spec -- ? )
primary-key>> +primary-key+? ; primary-key>> +primary-key+? ;
: native-id? ( spec -- ? ) : db-assigned-id-spec? ( spec -- ? )
primary-key>> +native-id+? ; primary-key>> +db-assigned-id+? ;
: nonnative-id? ( spec -- ? ) : assigned-id-spec? ( spec -- ? )
primary-key>> +nonnative-id+? ; primary-key>> +user-assigned-id+? ;
: normalize-spec ( spec -- ) : normalize-spec ( spec -- )
dup type>> dup +primary-key+? [ dup type>> dup +primary-key+? [
@ -82,8 +81,8 @@ FACTOR-BLOB NULL ;
: number>string* ( n/str -- str ) : number>string* ( n/str -- str )
dup number? [ number>string ] when ; dup number? [ number>string ] when ;
: maybe-remove-id ( specs -- obj ) : remove-db-assigned-id ( specs -- obj )
[ +native-id+? not ] filter ; [ +db-assigned-id+? not ] filter ;
: remove-relations ( specs -- newcolumns ) : remove-relations ( specs -- newcolumns )
[ relation? not ] filter ; [ relation? not ] filter ;