parent
1dbc37e0cd
commit
618e10a6b2
|
@ -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 ;
|
||||||
|
|
|
@ -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 ] }
|
||||||
|
|
|
@ -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 } }
|
||||||
|
|
|
@ -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 ] }
|
||||||
|
|
|
@ -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" } }
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
Loading…
Reference in New Issue