steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/db/db.factor
View File

@ -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 ;

2
extra/db/postgresql/lib/lib.factor
View File

@ -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 ] }

15
extra/db/postgresql/postgresql.factor
View File

@ -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>> <low-level-binding> ;
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 -- )
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 <insert-native-statement> ( class -- statement )
M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
[
"select add_" 0% 0%
"(" 0%
@ -193,7 +194,7 @@ M: postgresql-db <insert-native-statement> ( class -- statement )
");" 0%
] query-make ;
M: postgresql-db <insert-nonnative-statement> ( class -- statement )
M: postgresql-db <insert-user-assigned-statement> ( 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 } }

4
extra/db/sqlite/lib/lib.factor
View File

@ -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 ] }

14
extra/db/sqlite/sqlite.factor
View File

@ -79,7 +79,7 @@ M: literal-bind sqlite-bind-conversion ( tuple literal-bind -- array )
<sqlite-low-level-binding> ;
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> ;
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 <insert-native-statement> ( tuple -- statement )
M: sqlite-db <insert-db-assigned-statement> ( 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 <insert-native-statement> ( tuple -- statement )
");" 0%
] query-make ;
M: sqlite-db <insert-nonnative-statement> ( tuple -- statement )
<insert-native-statement> ;
M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
<insert-db-assigned-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" } }

42
extra/db/tuples/tuples-tests.factor
View File

@ -21,7 +21,7 @@ ts date time blob factor-blob ;
set-person-factor-blob
} 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 ;
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" } } <person> 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 <assigned-person> person1 set
2 "johnny" 10 3.14 f f f f f <assigned-person> person2 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 <user-assigned-person> 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 <assigned-person> person3 set
f <user-assigned-person> 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" } } <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: 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> 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

18
extra/db/tuples/tuples.factor
View File

@ -37,8 +37,8 @@ SYMBOL: sql-counter
HOOK: create-sql-statement db ( class -- obj )
HOOK: drop-sql-statement db ( class -- obj )
HOOK: <insert-native-statement> db ( class -- obj )
HOOK: <insert-nonnative-statement> db ( class -- obj )
HOOK: <insert-db-assigned-statement> db ( class -- obj )
HOOK: <insert-user-assigned-statement> db ( class -- obj )
HOOK: <update-tuple-statement> db ( class -- obj )
HOOK: <update-tuples-statement> 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 [ <insert-native-statement> ] cache
db get db-insert-statements [ <insert-db-assigned-statement> ] cache
[ bind-tuple ] 2keep insert-tuple* ;
: insert-nonnative ( tuple -- )
: insert-user-assigned-statement ( tuple -- )
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 ;
: 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

21
extra/db/types/types.factor
View File

@ -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> literal-bind
TUPLE: generator-bind key singleton type ;
TUPLE: generator-bind key generator-singleton type ;
C: <generator-bind> generator-bind
SINGLETON: random-id-generator
TUPLE: low-level-binding value ;
C: <low-level-binding> 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 ;