fix create table

This commit is contained in:
jackfoxy 2022-09-09 16:30:41 -07:00
parent b59ff55c99
commit 3f139a3a1b
2 changed files with 71 additions and 57 deletions

View File

@ -320,7 +320,7 @@
=/ foreign-keys `(list foreign-key:ast)`~
|-
?: =(~ f-keys)
foreign-keys
(flop foreign-keys)
?@ -<.f-keys
%= $ :: foreign key table must be in same DB as table
foreign-keys [(foreign-key:ast %foreign-key -<.f-keys -.a ->-.f-keys (qualified-object:ast %qualified-object ~ ->+<.a ->+<+>+<.f-keys ->+<+>+>.f-keys) ->+>.f-keys ~) foreign-keys]
@ -330,8 +330,9 @@
foreign-keys [(foreign-key:ast %foreign-key -<-.f-keys -.a -<+<.f-keys (qualified-object:ast %qualified-object ~ ->+<.a -<+>->+>-.f-keys -<+>->+>+.f-keys) -<+>+.f-keys ->.f-keys) foreign-keys]
f-keys +.f-keys
==
++ foreign-key
;~(pfix ;~(plug whitespace (jester 'foreign') whitespace (jester 'key')) ;~(plug parse-face ordered-column-list ;~(pfix ;~(plug whitespace (jester 'references')) ;~(plug (cook cook-qualified-2object parse-qualified-2-name) face-list))))
++ foreign-key-literal ~+ ;~(plug whitespace (jester 'foreign') whitespace (jester 'key'))
++ foreign-key ~+
;~(plug parse-face ordered-column-list ;~(pfix ;~(plug whitespace (jester 'references')) ;~(plug (cook cook-qualified-2object parse-qualified-2-name) face-list)))
++ referential-integrity ;~ plug
;~(pfix ;~(plug whitespace (jester 'on') whitespace) ;~(pose (jester 'update') (jester 'delete')))
;~(pfix whitespace ;~(pose (jester 'cascade') ;~(plug (jester 'no') whitespace (jester 'action'))))
@ -358,12 +359,20 @@
==
++ add-foreign-key ~+ ;~ plug
(cold %add-fk ;~(plug whitespace (jester 'add')))
(more com full-foreign-key)
;~(pfix foreign-key-literal (more com full-foreign-key))
==
++ drop-foreign-key ~+ ;~ plug
(cold %drop-fk ;~(plug whitespace (jester 'drop') whitespace (jester 'foreign') whitespace (jester 'key')))
face-list
==
++ primary-key
(cook cook-primary-key ;~(pfix ;~(plug whitespace (jester 'primary') whitespace (jester 'key')) ;~(pose ;~(plug clustering ordered-column-list) ordered-column-list)))
++ create-primary-key
|= a=[[@ ship=(unit @p) database=@t namespace=@t name=@t] key=*]
~| "a: {<a>}"
~| "key: {<key.a>}"
=/ key-name (crip (weld (weld "ix-primary-" (trip namespace.a)) (weld "-" (trip name.a))))
(create-index:ast %create-index key-name (qualified-object:ast %qualified-object ~ database.a namespace.a name.a) %.y +<:key.a +>:key.a)
::
:: parse urQL command
::
@ -403,14 +412,9 @@
;~(sfix ordered-column-list end-or-next-command)
==
++ parse-create-table ;~ plug
:: table name
;~(pfix whitespace parse-qualified-3object)
:: column defintions
column-definitions
:: primary key
(cook cook-primary-key ;~(pfix ;~(plug whitespace (jester 'primary') whitespace (jester 'key')) ;~(pose ;~(plug clustering ordered-column-list) ordered-column-list)))
:: foreign keys
;~(sfix (more com full-foreign-key) end-or-next-command)
;~(sfix ;~(pose ;~(plug primary-key ;~(pfix foreign-key-literal (more com full-foreign-key))) primary-key) end-or-next-command)
==
++ parse-insert ;~ plug
;~(pfix whitespace parse-qualified-object)
@ -545,12 +549,6 @@
=/ parsed (wonk table-nail)
=/ next-cursor
(get-next-cursor [script-position +<.command-nail p.q.u.+3:q.+3:table-nail])
~| "parsed: {<parsed>}"
~| "remainder: {<q.q.u.+3.q:table-nail>}"
~| "fks: {<`(build-foreign-keys [-.parsed +>.parsed])>}"
?: =(+<.parsed %alter-column)
%= $
script q.q.u.+3.q:table-nail
@ -577,14 +575,14 @@
script q.q.u.+3.q:table-nail
script-position next-cursor
commands
[`command-ast`(alter-table:ast %alter-table -.parsed ~ ~ ~ +>.parsed ~) commands]
[`command-ast`(alter-table:ast %alter-table -.parsed ~ ~ ~ (build-foreign-keys [-.parsed +>.parsed]) ~) commands]
==
?: =(+<.parsed %drop-fk)
%= $
script q.q.u.+3.q:table-nail
script-position next-cursor
commands
[`command-ast`(alter-table:ast %alter-table -.parsed ~ ~ ~ ~ (build-foreign-keys [-.parsed +>.parsed])) commands]
[`command-ast`(alter-table:ast %alter-table -.parsed ~ ~ ~ ~ ~) commands]
==
!!
%create-database
@ -671,19 +669,18 @@
=/ parsed (wonk table-nail)
=/ next-cursor
(get-next-cursor [script-position +<.command-nail p.q.u.+3:q.+3:table-nail])
=/ qualified-table -.parsed
=/ table-columns +<.parsed
=/ key +>-.parsed
=/ key-name (crip (weld (weld "ix-primary-" (trip +>+<.qualified-table)) (weld "-" (trip +>+>.qualified-table))))
=/ primary-key (create-index:ast %create-index key-name qualified-table %.y +<.key +>.key)
=/ foreign-keys (build-foreign-keys [qualified-table +>+.parsed])
~| "parsed: {<parsed>}"
~| "primary-key: {<primary-key>}"
?: ?=([* * [@ @ *]] parsed)
%= $ :: no foreign keys
script q.q.u.+3.q:table-nail
script-position next-cursor
commands
[`command-ast`(create-table:ast %create-table -.parsed +<.parsed (create-primary-key [-.parsed +>.parsed]) ~) commands]
==
%= $
script q.q.u.+3.q:table-nail
script-position next-cursor
commands
[`command-ast`(create-table:ast %create-table qualified-table table-columns primary-key foreign-keys) commands]
[`command-ast`(create-table:ast %create-table -.parsed +<.parsed (create-primary-key [-.parsed +>-.parsed]) (build-foreign-keys [-.parsed +>+.parsed])) commands]
==
%create-view
!!

View File

@ -30,9 +30,9 @@
!> ~[expected1 expected2]
!> (parse:parse(current-database 'db1') "aLter \0d INdEX\09db.ns.my-index On db.ns.table ( col1 asc , col2\0a desc , col3) \0a dIsable \0a;\0a aLter \0d INdEX\09db..my-index On db..table ( col1 asc ) \0a \0a rEBuild ")
::
:: alter index 1 column without action is mysteriously broken
:: alter index 1 column without action
++ test-alter-index-2
=/ expected
=/ expected [%alter-index name=[%qualified-object ship=~ database='db' namespace='ns' name='my-index'] object=[%qualified-object ship=~ database='db' namespace='ns' name='table'] columns=~[[%ordered-column column-name='col1' is-ascending=%.y]] action=%rebuild]
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "ALTER INDEX db.ns.my-index ON db.ns.table (col1)")
@ -46,7 +46,7 @@
::
:: alter index table no columns, action only
++ test-alter-index-4
=/ expected
=/ expected [%alter-index name=[%qualified-object ship=~ database='db1' namespace='dbo' name='my-index'] object=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] columns=~ action=%resume]
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "ALTER INDEX my-index ON table RESUME")
@ -94,67 +94,68 @@
:: tests 1, 2, 3, 5, and extra whitespace characters
:: alter column db.ns.table 3 columns ; alter column db..table 1 column
++ test-alter-table-1
=/ expected1 [%alter-table table=[%qualified-object ship=~ database='db1' namespace='ns' name='table'] alter-columns=~ add-columns=[~ ~[[%column name='col1' column-type='@t'] [%column name='col2' column-type='@p'] [%column name='col3' column-type='@ud']]] drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
=/ expected2 [%alter-table table=[%qualified-object ship=~ database='db' namespace='dbo' name='table'] alter-columns=~ add-columns=[~ ~[[%column name='col1' column-type='@t']]] drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
=/ expected1 [%alter-table table=[%qualified-object ship=~ database='db' namespace='ns' name='table'] alter-columns=~ add-columns=~[[%column name='col1' column-type='@t'] [%column name='col2' column-type='@p'] [%column name='col3' column-type='@ud']] drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
=/ expected2 [%alter-table table=[%qualified-object ship=~ database='db' namespace='dbo' name='table'] alter-columns=~ add-columns=~[[%column name='col1' column-type='@t']] drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
%+ expect-eq
!> ~[expected1 expected2]
!> (parse:parse(current-database 'db1') " ALtER TaBLE db.ns.table AdD COlUMN ( col1 @t , col2 @p , col3 @ud ) \0a;\0a ALTER TABLE db..table ADD COLUMN (col1 @t) ")
::
:: alter column table 3 columns
++ test-alter-table-2
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=[~ ~[[%column name='col1' column-type='@t'] [%column name='col2' column-type='@p'] [%column name='col3' column-type='@ud']]] add-columns=~ drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=~[[%column name='col1' column-type='@t'] [%column name='col2' column-type='@p'] [%column name='col3' column-type='@ud']] add-columns=~ drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "ALTER TABLE table ALTER COLUMN (col1 @t, col2 @p, col3 @ud)")
::
:: alter column table 1 column
++ test-alter-table-3
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=[~ ~[[%column name='col1' column-type='@t']]] add-columns=~ drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=~[[%column name='col1' column-type='@t']] add-columns=~ drop-columns=~ add-foreign-keys=~ drop-foreign-keys=~]
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "ALTER TABLE table ALTER COLUMN (col1 @t)")
::
:: drop column table 3 columns
++ test-alter-table-4
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=~ add-columns=~ drop-columns=[~ ['col1' 'col2' 'col3' ~]] add-foreign-keys=~ drop-foreign-keys=~]
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=~ add-columns=~ drop-columns=['col1' 'col2' 'col3' ~] add-foreign-keys=~ drop-foreign-keys=~]
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "ALTER TABLE table DROP COLUMN (col1, col2, col3)")
::
:: drop column table 1 column
++ test-alter-table-5
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=~ add-columns=~ drop-columns=[~ ['col1' ~]] add-foreign-keys=~ drop-foreign-keys=~]
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=~ add-columns=~ drop-columns=['col1' ~] add-foreign-keys=~ drop-foreign-keys=~]
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "ALTER TABLE table DROP COLUMN (col1)")
::
:: add foreign key 1 fk
++ test-alter-table-
=/ expected
:: add 2 foreign keys, extra spaces and mixed case key words
++ test-alter-table-6
=/ expected [%alter-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] alter-columns=~ add-columns=~ drop-columns=~ add-foreign-keys=~[[%foreign-key name='fk' table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] columns=~[[%ordered-column column-name='col1' is-ascending=%.y] [%ordered-column column-name='col2' is-ascending=%.n]] reference-table=[%qualified-object ship=~ database='db1' namespace='dbo' name='fk-table'] reference-columns=['col19' 'col20' ~] referential-integrity=~[%delete-cascade %update-cascade]] [%foreign-key name='fk2' table=[%qualified-object ship=~ database='db1' namespace='dbo' name='table'] columns=~[[%ordered-column column-name='col1' is-ascending=%.y] [%ordered-column column-name='col2' is-ascending=%.n]] reference-table=[%qualified-object ship=~ database='db1' namespace='dbo' name='fk-table2'] reference-columns=['col19' 'col20' ~] referential-integrity=~[%delete-cascade %update-cascade]]] drop-foreign-keys=~]
=/ urql "ALTER TABLE table ADD FOREIGN KEY fk ( col1 , col2 desc ) reFerences fk-table ( col19 , col20 ) On dELETE CAsCADE oN UPdATE CAScADE, fk2 ( col1 , col2 desc ) reFerences fk-table2 ( col19 , col20 ) On dELETE CAsCADE oN UPdATE CAScADE "
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "")
!> (parse:parse(current-database 'db1') urql)
::
::
++ test-alter-table-
=/ expected
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "")
::++ test-alter-table-
:: =/ expected
:: %+ expect-eq
:: !> ~[expected]
:: !> (parse:parse(current-database 'db1') "")
::
::
++ test-alter-table-
=/ expected
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "")
::++ test-alter-table-
:: =/ expected
:: %+ expect-eq
:: !> ~[expected]
:: !> (parse:parse(current-database 'db1') "")
::
::
++ test-alter-table-
=/ expected
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') "")
::++ test-alter-table-
:: =/ expected
:: %+ expect-eq
:: !> ~[expected]
:: !> (parse:parse(current-database 'db1') "")
::
:: create database
@ -312,14 +313,30 @@
!> ~[expected]
!> (parse:parse(current-database 'db1') urql)
::
:: create table... no foreign key
++ test-create-table-7
=/ expected [%create-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='my-table'] columns=~[[%column name='col1' column-type='@t'] [%column name='col2' column-type='@p'] [%column name='col3' column-type='@ud']] primary-key=[%create-index name='ix-primary-dbo-my-table' object-name=[%qualified-object ship=~ database='db1' namespace='dbo' name='my-table'] is-unique=%.y is-clustered=%.n columns=~[[%ordered-column column-name='col1' is-ascending=%.y] [%ordered-column column-name='col2' is-ascending=%.y]]] foreign-keys=~]
=/ urql "create table my-table (col1 @t,col2 @p,col3 @ud) primary key (col1,col2)"
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') urql)
::
:: create table... 2 foreign keys
++ test-create-table-8
=/ expected [%create-table table=[%qualified-object ship=~ database='db1' namespace='dbo' name='my-table'] columns=~[[%column name='col1' column-type='@t'] [%column name='col2' column-type='@p'] [%column name='col3' column-type='@ud']] primary-key=[%create-index name='ix-primary-dbo-my-table' object-name=[%qualified-object ship=~ database='db1' namespace='dbo' name='my-table'] is-unique=%.y is-clustered=%.n columns=~[[%ordered-column column-name='col1' is-ascending=%.y]]] foreign-keys=~[[%foreign-key name='fk' table=[%qualified-object ship=~ database='db1' namespace='dbo' name='my-table'] columns=~[[%ordered-column column-name='col2' is-ascending=%.n]] reference-table=[%qualified-object ship=~ database='db1' namespace='dbo' name='fk-table'] reference-columns=['col20' ~] referential-integrity=~] [%foreign-key name='fk2' table=[%qualified-object ship=~ database='db1' namespace='dbo' name='my-table'] columns=~[[%ordered-column column-name='col1' is-ascending=%.y] [%ordered-column column-name='col2' is-ascending=%.n]] reference-table=[%qualified-object ship=~ database='db1' namespace='dbo' name='fk-table2'] reference-columns=['col19' 'col20' ~] referential-integrity=~]]]
=/ urql "create table my-table (col1 @t,col2 @p,col3 @ud) primary key (col1) foreign key fk (col2 desc) reFerences fk-table (col20), fk2 (col1, col2 desc) reFerences fk-table2 (col19, col20)"
%+ expect-eq
!> ~[expected]
!> (parse:parse(current-database 'db1') urql)
::
:: fail when database qualifier on foreign key table db.ns.fk-table
++ test-fail-create-table-7
++ test-fail-create-table-9
=/ urql "create table my-table (col1 @t,col2 @p,col3 @ud) primary key (col1) foreign key fk (col2 desc) reFerences db.ns.fk-table (col20) "
%- expect-fail
|. (parse:parse(current-database 'other-db') urql)
::
:: fail when database qualifier on foreign key table db..fk-table
++ test-fail-create-table-8
++ test-fail-create-table-10
=/ urql "create table my-table (col1 @t,col2 @p,col3 @ud) primary key (col1) foreign key fk (col2 desc) reFerences db..fk-table (col20) "
%- expect-fail
|. (parse:parse(current-database 'other-db') urql)