Skip to content

Commit

Permalink
Merge pull request #143 from fukamachi/is-null-in-find-dao
Browse files Browse the repository at this point in the history 
Generate `IS NULL` query by specifying `NIL` for key-value style query functions.
  • Loading branch information
@fukamachi
fukamachi authored Jun 28, 2024
2 parents 31393c4 + a97513b commit b42a5e6
Show file tree
Hide file tree
Showing 2 changed files with 63 additions and 89 deletions.
31 changes: 26 additions & 5 deletions src/core/dao.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,9 +19,11 @@
#:find-slot-by-name
#:find-parent-column
#:find-child-columns
#:table-name
#:table-column-references-column
#:table-column-name
#:table-column-type)
#:table-column-type
#:table-column-not-null-p)
(:import-from #:mito.db
#:last-insert-id
#:execute-sql
Expand Down Expand Up @@ -159,6 +161,7 @@
primary-key))))))
(values))
(:method :before ((obj record-timestamps-mixin) &key columns)
(declare (ignore columns))
(let ((now (local-time:now)))
(setf (object-updated-at obj) now))))

Expand Down Expand Up @@ -341,14 +344,32 @@
(find-child-columns class slot))))
(when children
`((:and ,@(loop for child in children
for column = (intern (table-column-name child) :keyword)
collect
`(:= ,(intern (table-column-name child) :keyword)
(cond
((null value)
(unless (table-column-not-null-p slot)
(warn "Slot ~S in table ~S is not null, but IS NULL condition is specified."
(table-column-name slot)
(table-name class)))
`(:is-null ,column))
(t
`(:= ,column
,(slot-value value
(c2mop:slot-definition-name
(table-column-references-column child)))))))))
(table-column-references-column child)))))))))))
else
collect `(:= ,(unlispify field)
,(dao-table-column-deflate slot value)))))
collect (let ((db-value
(dao-table-column-deflate slot value)))
(cond
((null db-value)
(unless (table-column-not-null-p slot)
(warn "Slot ~S in table ~S is not null, but IS NULL condition is specified."
(table-column-name slot)
(table-name class)))
`(:is-null ,(unlispify field)))
(t
`(:= ,(unlispify field) ,db-value)))))))
(when op
(sxql:where `(:and ,@op))))))

Expand Down
121 changes: 37 additions & 84 deletions t/dao.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,4 @@
(defpackage #:mito-test.dao
(:use #:cl))
(in-package #:mito-test.dao)

;;; separate packages to avoid conflicting defclasses for testing

(defpackage #:mito-test.dao.1
(:use #:cl
#:rove
#:mito.dao
Expand All @@ -14,7 +8,7 @@
(:import-from #:alexandria
#:make-keyword
#:compose))
(in-package #:mito-test.dao.1)
(in-package #:mito-test.dao)

(deftest dao-table-class-inheritance
(when (find-class 'tweet nil)
Expand Down Expand Up @@ -88,20 +82,9 @@
status TEXT NOT NULL,
user INTEGER NOT NULL
)"
"auto-pk is nil"))
"auto-pk is nil")


(defpackage #:mito-test.dao.2
(:use #:cl
#:rove
#:mito.dao
#:mito.connection
#:mito-test.util
#:sxql)
(:import-from #:alexandria
#:make-keyword
#:compose))
(in-package #:mito-test.dao.2)
(setf (find-class 'tweet) nil))

(deftest relation
(setf *connection* (connect-to-testdb :mysql))
Expand All @@ -120,7 +103,8 @@
((id :col-type :serial
:primary-key t)
(name :col-type :text
:initarg :name)
:initarg :name
:accessor user-name)
(setting :col-type (or user-setting :null)
:initarg :setting
:accessor user-setting))
Expand Down Expand Up @@ -149,9 +133,12 @@
(mito:ensure-table-exists 'user-setting)
(mito:ensure-table-exists 'user)
(mito:ensure-table-exists 'tweet)
(let ((user (mito:create-dao 'user :name "Eitaro")))
(let ((user (mito:create-dao 'user
:name "Eitaro")))
(mito:create-dao 'tweet :status "Hello" :user user))
(let ((user (mito:create-dao 'user :name "Yoshimi")))
(let ((user (mito:create-dao 'user
:name "Yoshimi"
:setting (mito:create-dao 'user-setting))))
(mito:create-dao 'tweet :status "こんにちは" :user user))

(ok (= (mito:count-dao 'tweet) 2))
Expand All @@ -160,10 +147,10 @@
(let ((tweet (first (mito:select-dao 'tweet (sxql:limit 1)))))
(setf (tweet-status tweet) "Goodbye, World")
(setf (tweet-user tweet) (mito:find-dao 'user :name "Yoshimi"))
(mito:update-dao 'user :columns '(:status))
(mito:update-dao tweet :columns '(:status))
(ok (equal (user-name (tweet-user (first (mito:select-dao 'tweet (sxql:limit 1)))))
"Eitaro"))
(mito:update-dao 'user)
(mito:update-dao tweet)
(ok (equal (user-name (tweet-user (first (mito:select-dao 'tweet (sxql:limit 1)))))
"Yoshimi")))
(dbi:rollback mito:*connection*))
Expand Down Expand Up @@ -227,8 +214,12 @@
(ok
(mito.dao:select-dao 'tweet
(where (:in :user (list user))))))
(testing "Can generate IS NULL query by find-dao"
(ok (mito:find-dao 'user :name "Eitaro" :setting nil))
(ok (eql 4 (mito:count-dao 'user)))
(ok (eql 3 (mito:count-dao 'user :setting nil))))

(ok (null (user-setting (mito:find-dao 'user))))
(ok (null (user-setting (mito:find-dao 'user :name "Eitaro"))))

(defclass tweet2 (tweet) ()
(:metaclass dao-table-class)
Expand All @@ -247,20 +238,10 @@
(mito:delete-by-values 'tweet :id 2)
(ok (= (mito:count-dao 'tweet) 0)))

(dolist (class-name '(user-setting user tweet friend-relationship tweet2))
(setf (find-class class-name) nil))
(disconnect-toplevel))

(defpackage #:mito-test.dao.3
(:use #:cl
#:rove
#:mito.dao
#:mito.connection
#:mito-test.util
#:sxql)
(:import-from #:alexandria
#:make-keyword
#:compose))
(in-package #:mito-test.dao.3)

(deftest foreign-slots
(setf *connection* (connect-to-testdb :mysql))
(defclass user ()
Expand Down Expand Up @@ -297,20 +278,10 @@
KEY (user_id, tweet_id)
)")))

(dolist (class-name '(user tweet tweet-tag))
(setf (find-class class-name) nil))
(disconnect-toplevel))

(defpackage #:mito-test.dao.4
(:use #:cl
#:rove
#:mito.dao
#:mito.connection
#:mito-test.util
#:sxql)
(:import-from #:alexandria
#:make-keyword
#:compose))
(in-package #:mito-test.dao.4)

(deftest inflate-deflate
(dolist (driver '(:mysql :postgres :sqlite3))
(testing (format nil "inflate & deflate (~A)" driver)
Expand Down Expand Up @@ -350,19 +321,9 @@
(ok (typep (mito:object-created-at user) 'local-time:timestamp)))
(let ((user (mito:find-dao 'user :role :manager)))
(ok user)))
(disconnect-toplevel))))

(defpackage #:mito-test.dao.5
(:use #:cl
#:rove
#:mito.dao
#:mito.connection
#:mito-test.util
#:sxql)
(:import-from #:alexandria
#:make-keyword
#:compose))
(in-package #:mito-test.dao.5)
(setf (find-class 'user) nil)
(disconnect-toplevel))))

(deftest timestamp-with-milliseconds
(setf *connection* (connect-to-testdb :postgres))
Expand All @@ -379,31 +340,20 @@
(let ((user (mito:find-dao 'user :id 1)))
(ok (typep (slot-value user 'registered-at) 'local-time:timestamp))
(ok (/= 0 (local-time:nsec-of (slot-value user 'registered-at))))))
(setf (find-class 'user) nil)
(disconnect-toplevel))

(defpackage #:mito-test.dao.6
(:use #:cl
#:rove
#:mito.dao
#:mito.connection
#:mito-test.util
#:sxql)
(:import-from #:alexandria
#:make-keyword
#:compose))
(in-package #:mito-test.dao.6)

(defclass parent ()
()
(:metaclass dao-table-class))
(deftest accessor
(defclass parent ()
()
(:metaclass dao-table-class))

(defclass child ()
((parent :col-type parent
:initarg :parent
:accessor child-parent))
(:metaclass dao-table-class))
(defclass child ()
((parent :col-type parent
:initarg :parent
:accessor child-parent))
(:metaclass dao-table-class))

(deftest accessor
(setf *connection* (connect-to-testdb :postgres))
(mito:execute-sql (sxql:drop-table :parent :if-exists t))
(mito:execute-sql (sxql:drop-table :child :if-exists t))
Expand All @@ -412,4 +362,7 @@
(mito:create-dao 'child :parent (mito:create-dao 'parent))
(child-parent (mito:find-dao 'child))
(ok (object= (child-parent (mito:find-dao 'child))
(mito:find-dao 'parent))))
(mito:find-dao 'parent)))

(dolist (class-name '(parent child))
(setf (find-class class-name) nil)))

0 comments on commit b42a5e6

Please sign in to comment.