Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Feat: column slot foreign-key #80

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Feat: column slot foreign-key #80

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
56 changes: 37 additions & 19 deletions README.markdown
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -134,36 +134,54 @@ Creates a SELECT query. It takes a field (or a list of fields) and SQL Clauses.

```common-lisp
(create-table :enemy
((name :type 'string
((name :type 'varchar
:primary-key t)
(age :type 'integer
:not-null t)
(address :type 'text
:not-null nil)
(fatal_weakness :type 'text
:not-null t
:default "None")
(identifying_color :type '(:char 20)
:unique t)))
;=> #<SXQL-STATEMENT: CREATE TABLE enemy (name STRING PRIMARY KEY, age INTEGER NOT NULL, address TEXT, fatal_weakness TEXT NOT NULL DEFAULT 'None', identifying_color CHAR(20) UNIQUE)>
:not-null nil
:unique t)))
;=> #<SXQL-STATEMENT: CREATE TABLE enemy (
; name VARCHAR PRIMARY KEY,
; age INTEGER NOT NULL,
; address TEXT UNIQUE
; )>

(yield *)
;=> "CREATE TABLE enemy (name STRING PRIMARY KEY, age INTEGER NOT NULL, address TEXT, fatal_weakness TEXT NOT NULL DEFAULT ?, identifying_color CHAR(20) UNIQUE)"
; ("None")

(create-table (:enemy :if-not-exists t)
((name :type 'string
:primary-key t)
(age :type 'integer
;=> "CREATE TABLE enemy (
; name VARCHAR PRIMARY KEY,
; age INTEGER NOT NULL,
; address TEXT UNIQUE
; )"
; NIL
```
```common-lisp
(create-table (:enemy-details :if-not-exists t)
((name :type :varchar
:references '(:enemy :name))
:primary-key t)
(time :type 'integer
:not-null t)
(address :type 'text
:not-null nil)
(fatal_weakness :type 'text
:not-null t
:default "None")
(identifying_color :type '(:char 20)
:unique t)))
;=> #<SXQL-STATEMENT: CREATE TABLE IF NOT EXISTS enemy (name STRING PRIMARY KEY, age INTEGER NOT NULL, address TEXT, fatal_weakness TEXT NOT NULL DEFAULT 'None', identifying_color CHAR(20) UNIQUE)>
:unique t))
;=> #<SXQL-STATEMENT: CREATE TABLE IF NOT EXISTS enemy-details (
; id BIGINT PRIMARY KEY FOREIGN KEY REFERENCES enemy (name),
; time INTEGER NOT NULL,
; fatal_weakness TEXT NOT NULL DEFAULT 'None',
; identifying_color CHAR(20) UNIQUE
; )>

(yield *)
;=> "CREATE TABLE IF NOT EXISTS enemy-details (
; id BIGINT PRIMARY KEY FOREIGN KEY REFERENCES enemy (name),
; time INTEGER NOT NULL,
; fatal_weakness TEXT NOT NULL DEFAULT ?,
; identifying_color CHAR(20) UNIQUE
; )"
; ("None")
```

### drop-table (table &key if-exists)
Expand Down
142 changes: 101 additions & 41 deletions src/clause.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,9 @@
:sql-symbol-name
:sql-list-elements
:expression-clause-expression)
(:import-from #:alexandria
#:if-let
#:when-let)
(:import-from :sxql.operator
:=-op
:as-op
Expand Down Expand Up @@ -179,6 +182,7 @@
(defstruct (unique-key-clause (:include key-clause (name "UNIQUE"))
(:constructor make-unique-key-clause (expression))))

;; FOREIGN KEY DEFINITION
@export
(defstruct (references-clause (:include expression-clause (name "REFERENCES"))
(:constructor make-references-clause (table-name column-names
Expand All @@ -195,36 +199,30 @@
(slot-value clause 'name)
(on-clause-action clause))
nil))

(defstruct (on-delete-clause (:include on-clause (name "ON DELETE"))))
(defstruct (on-update-clause (:include on-clause (name "ON UPDATE"))))

@export
(defstruct (foreign-key-clause (:include expression-clause (name "FOREIGN KEY"))
(:constructor make-foreign-key-clause (column-names references on-delete on-update
&aux (expression
(apply #'make-sql-splicing-expression-list
column-names references
(append
(and on-delete
(list
(make-on-delete-clause :action on-delete)))
(and on-update
(list
(make-on-update-clause :action on-update)))))))))
(column-names nil :type sql-list)
(references nil :type references-clause))
(defstruct (foreign-key-clause (:include expression-clause (name "FOREIGN KEY")))
(column-names nil :type (or sql-list null))
(references nil :type references-clause)
(on-delete nil :type (or null on-delete-clause))
(on-update nil :type (or null on-update-clause)))

@export
(defstruct (column-definition-clause (:include sql-clause)
(:constructor %make-column-definition-clause (column-name &key type not-null default auto-increment autoincrement unique primary-key)))
column-name
type
not-null
default
auto-increment
autoincrement
unique
primary-key)
(:constructor %make-column-definition-clause
(column-name &key type not-null default auto-increment autoincrement foreign-key unique primary-key)))
(column-name nil :type sql-symbol)
(type nil :type sql-column-type)
(not-null nil :type boolean)
(default nil :type (or sql-variable null))
(auto-increment nil :type boolean)
(autoincrement nil :type boolean)
(foreign-key nil :type (or foreign-key-clause null))
(unique nil :type boolean)
(primary-key nil :type boolean))

(defstruct (column-modifier-clause (:include expression-clause)
(:constructor nil))
Expand Down Expand Up @@ -302,15 +300,22 @@
(:constructor make-drop-column-clause (expression))))

@export
(defun make-column-definition-clause (column-name &rest args &key type not-null default auto-increment autoincrement unique primary-key)
(declare (ignore type not-null default auto-increment autoincrement unique primary-key))
(defun make-column-definition-clause (column-name &rest args &key type not-null default auto-increment autoincrement unique foreign-key primary-key)
(declare (ignore type not-null default auto-increment autoincrement unique foreign-key primary-key))
(apply #'%make-column-definition-clause
(detect-and-convert column-name)
(loop for (key val) on args by #'cddr
if (eq key :type)
append (list key (make-sql-column-type-from-list val))
else
append (list key (detect-and-convert val)))))
if (eq key :foreign-key)
append (list key
(make-clause :foreign-key
:references (getf val :references)
:on-update (getf val :on-update)
:on-delete (getf val :on-delete)))
else
append (list key (detect-and-convert val)))))

(defmethod yield ((clause column-definition-clause))
(with-yield-binds
Expand All @@ -332,6 +337,9 @@
(write-string " UNIQUE" s))
(when (column-definition-clause-primary-key clause)
(write-string " PRIMARY KEY" s))
(when-let (foreign-key
(column-definition-clause-foreign-key clause))
(format s " ~A" (yield foreign-key)))
(when (and (column-definition-clause-autoincrement clause)
(not (column-definition-clause-auto-increment clause)))
(write-string " AUTOINCREMENT" s)))))
Expand Down Expand Up @@ -389,7 +397,6 @@
(t 2))
(yield (on-conflict-do-nothing-clause-conflict-target clause))))


(defstruct (on-conflict-do-update-clause (:include sql-clause (name "ON CONFLICT DO UPDATE"))
(:constructor %make-on-conflict-do-update-clause (conflict-target update-set &optional where-condition)))
(conflict-target nil :type (or sql-list sql-symbol))
Expand Down Expand Up @@ -457,20 +464,6 @@
(defmethod make-clause ((clause-name (eql :unique-key)) &rest args)
(apply #'make-key-clause-for-all #'make-unique-key-clause args))

(defmethod make-clause ((clause-name (eql :foreign-key)) &rest args)
(destructuring-bind (column-names &key references on-delete on-update) args
(destructuring-bind (target-table-name &rest target-column-names) references
(make-foreign-key-clause
(apply #'make-sql-list (mapcar #'detect-and-convert
(if (listp column-names)
column-names
(list column-names))))
(make-references-clause (detect-and-convert target-table-name)
(apply #'make-sql-list (mapcar #'detect-and-convert
target-column-names)))
on-delete
on-update))))

(defmethod make-clause ((clause-name (eql :add-column)) &rest args)
(apply #'make-column-modifier-clause #'make-add-column-clause
nil args))
Expand Down Expand Up @@ -503,6 +496,56 @@
(cadr args)
(caddr args)))

(defmethod make-clause ((clause-name (eql :foreign-key)) &key column-names references on-delete on-update)
(flet ((canonicalize-action (action)
(etypecase action
(keyword
(ecase action
(:no-action "NO ACTION")
(:set-null "SET NULL")
(:set-default "SET DEFAULT")
((:restrict :cascade)
(symbol-name action))))
(string action)
(null action))))
(unless references
(error "You have to supply references with foreign key."))
(let* ((target-columns
(cdr references))
(column-length
(if (atom column-names)
1
(list-length column-names)))
(target-column-length
(if (atom target-columns)
1
(list-length target-columns))))
(unless target-columns
(error "You have to supply at least one references target-columns."))
(when (and (not column-names)
(not (or (atom target-columns)
(eql 1 (list-length target-columns)))))
(error "You have to supply exactly one references target-column with inline references."))
(unless (eql column-length target-column-length)
(error "Supplied columns count (~A) not identical with target-columns count (~A)."
column-length
target-column-length))
;(break)
(make-foreign-key-clause
:column-names (when column-names
(apply #'make-sql-list (mapcar #'detect-and-convert
(if (consp column-names)
column-names
(list column-names)))))
:references (make-references-clause (detect-and-convert (first references))
(apply #'make-sql-list (mapcar #'detect-and-convert
(cdr references))))
:on-delete (when on-delete
(make-on-delete-clause :action (canonicalize-action on-delete)))
:on-update (when on-update
(make-on-update-clause :action (canonicalize-action on-update)))))))


(defmethod yield ((clause limit-clause))
(let ((*use-placeholder* nil))
(call-next-method)))
Expand Down Expand Up @@ -544,6 +587,23 @@
(format nil "SET ~{~A = ~A~^, ~}"
(mapcar #'yield-arg (set=-clause-args clause)))))))


(defmethod yield ((clause foreign-key-clause))
(with-yield-binds
(with-output-to-string (s)
(if-let (column-names
(foreign-key-clause-column-names clause))
(format s "FOREIGN KEY ~A ~A"
(yield column-names)
(yield (foreign-key-clause-references clause)))
(write-string (yield (foreign-key-clause-references clause)) s))
(when-let (on-delete
(foreign-key-clause-on-delete clause))
(format s " ~A" (yield on-delete)))
(when-let (on-update
(foreign-key-clause-on-update clause))
(format s " ~A" (yield on-update))))))

(defun make-sql-column-type-from-list (val)
(destructuring-bind (type &optional args &rest attrs)
(if (listp val)
Expand Down
19 changes: 3 additions & 16 deletions src/sxql.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -279,22 +279,9 @@
(apply #'make-clause :key key-args))

@export
(defun foreign-key (column-names &key references on-delete on-update)
(flet ((canonicalize-action (action)
(etypecase action
(keyword
(ecase action
(:no-action "NO ACTION")
(:set-null "SET NULL")
((:restrict :cascade)
(symbol-name action))))
(string action)
(null action))))
(make-clause :foreign-key
column-names
:references references
:on-delete (canonicalize-action on-delete)
:on-update (canonicalize-action on-update))))
(defun foreign-key (column-names &rest args &key references on-delete on-update)
(declare (ignore references on-delete on-update))
(apply #'make-clause (list* :foreign-key :column-names column-names args)))

@export
(defun add-column (column-name &rest args)
Expand Down
11 changes: 10 additions & 1 deletion t/clause.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -177,9 +177,18 @@
(sxql.sql-type:make-sql-list (sxql.sql-type:make-sql-symbol "id"))))

(is (multiple-value-list
(yield (make-clause :foreign-key '(:project_id) :references '(:project :id))))
(yield (make-clause :foreign-key :column-names '(:project_id) :references '(:project :id))))
(list "FOREIGN KEY (`project_id`) REFERENCES `project` (`id`)" nil))

(is (multiple-value-list
(yield (make-clause :foreign-key :column-names '(:project_id) :references '(:project :id) :on-update :set-default)))
(list "FOREIGN KEY (`project_id`) REFERENCES `project` (`id`) ON UPDATE SET DEFAULT"
nil))

(is (multiple-value-list
(yield (make-clause :foreign-key :column-names nil :references '(:project :id) :on-delete :cascade)))
(list "REFERENCES `project` (`id`) ON DELETE CASCADE" nil))

(is (yield (sxql.clause::make-sql-column-type-from-list '(:integer)))
"INTEGER")
(is (yield (sxql.clause::make-sql-column-type-from-list '(:integer 11)))
Expand Down
42 changes: 42 additions & 0 deletions t/statement.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -182,6 +182,48 @@
)" ("None"))
"CREATE TABLE IF NOT EXISTS")

(is (multiple-value-list
(yield (make-statement :create-table
'(:table3)
'((:fatal_weakness :type text
:not-null t
:default "None"
:foreign-key (:references (:nxt-table :nxt-column) :on-update :restrict))
(:identifying_color :type (:char 20)
:foreign-key (:references (:iden-table :iden-colum) :on-delete :set-default)
:unique t)))))
'("CREATE TABLE `table3` (
`fatal_weakness` TEXT NOT NULL DEFAULT ? REFERENCES `nxt-table` (`nxt-column`) ON UPDATE RESTRICT,
`identifying_color` CHAR(20) UNIQUE REFERENCES `iden-table` (`iden-colum`) ON DELETE SET DEFAULT
)"
("None")))

(is (multiple-value-list
(yield (make-statement :create-table
'(:enemy :if-not-exists nil)
'((:age :type integer
:not-null t)
(:address :type text
:not-null nil
:foreign-key (:references (:fk-table :fk-column) :on-delete :set-null :on-update :no-action))))))
'("CREATE TABLE `enemy` (
`age` INTEGER NOT NULL,
`address` TEXT REFERENCES `fk-table` (`fk-column`) ON DELETE SET NULL ON UPDATE NO ACTION
)"
nil))

(is (multiple-value-list
(yield (make-statement
:create-table
'(:enemy :if-not-exists t)
'((:name :type string
:foreign-key (:references (:foreign-key-table :foreign-key-column))
:primary-key t)))))
'("CREATE TABLE IF NOT EXISTS `enemy` (
`name` STRING PRIMARY KEY REFERENCES `foreign-key-table` (`foreign-key-column`)
)"
nil))

(is (multiple-value-list
(yield (make-statement :alter-table :tweet
(make-clause :add-column :id
Expand Down
Loading