commit f378df5dd6db182615a4adc4e8bc251db98763e3
parent ea0de3f88915002b1d044977f12fa9ed91d9de87
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Mon, 12 Oct 2020 21:00:09 -0700
Starting to decouple the blog data from the DB
Diffstat:
| M | miniblog.asd | | | 3 | ++- |
| A | src/data.lisp | | | 88 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | src/db.lisp | | | 129 | +++++++++++++++++++++++++++----------------------------------------------------- |
| M | src/miniblog.lisp | | | 64 | ++++++++++++++++++++++++++++++++-------------------------------- |
| M | src/packages.lisp | | | 20 | ++++++++++++++++++-- |
| A | tst/data.lisp | | | 217 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| D | tst/db.lisp | | | 217 | ------------------------------------------------------------------------------- |
7 files changed, 400 insertions(+), 338 deletions(-)
diff --git a/miniblog.asd b/miniblog.asd
@@ -26,6 +26,7 @@ into date-structured directories as a normal HTML."
(:file "format")
(:file "edit")
(:file "db")
+ (:file "data")
(:file "content")
(:file "miniblog")))
(:module "templates"
@@ -53,5 +54,5 @@ into date-structured directories as a normal HTML."
:components ((:file "packages")
(:file "format")
(:file "edit")
- (:file "db"))))
+ (:file "data"))))
:perform (test-op (o c) (symbol-call :miniblog/tests :run-miniblog-tests)))
diff --git a/src/data.lisp b/src/data.lisp
@@ -0,0 +1,88 @@
+(in-package :miniblog.data)
+
+(defgeneric xform (entry)
+ (:documentation "Transform an entry of some type into an idiomatic p-list"))
+
+(defmethod xform ((entry blog-entries))
+ "Transform a blog-entries object into an idiomatic property list"
+ (list :id (mito.dao.mixin:object-id entry)
+ :created-at (mito.dao.mixin:object-created-at entry)
+ :last-updated-at (mito.dao.mixin:object-updated-at entry)
+ :title (entry-title entry)
+ :content (entry-content entry)
+ :created-by (entry-username entry)
+ :last-updated-by (entry-last-updated-by entry)))
+
+(defmethod xform ((entry blog-pages))
+ "Transform a blog-pages object into an idiomatic p-list"
+ (list :id (mito.dao.mixin:object-id entry)
+ :created-at (mito.dao.mixin:object-created-at entry)
+ :last-updated-at (mito.dao.mixin:object-updated-at entry)
+ :name (page-name entry)
+ :parent (page-parent entry)
+ :title (page-title entry)
+ :content (page-content entry)
+ :created-by (page-username entry)
+ :last-updated-by (page-last-updated-by entry)))
+
+(defun add-entry (title content &key (username "nobody"))
+ (miniblog.db:add-entry title content :username username :transform #'xform))
+
+(defun get-entry (id)
+ "Get entry by id, or nil if the requested id isn't found"
+ (miniblog.db:get-entry id :transform #'xform))
+
+(defmacro with-entry-id (entry id &rest body)
+ "Takes a varname to hold the entry list and a post id
+ and executes the forms in body with the entry bound
+ to the specified entry variable"
+ `(let ((,entry (miniblog.db:get-entry ,id)))
+ (if ,entry
+ (progn ,@body)
+ (format t "Post ID ~d not found~%" ,id))))
+
+(defun get-entries (&key year month max-entries)
+ "Get entries from the database, optionally limited to a date
+ range or count"
+ (miniblog.db:get-entries :year year :month month :max-entries max-entries :transform #'xform))
+
+(defun update-entry (id title content &key (username "nobody"))
+ "Update entry by id. Returns the updated entry or nil if the id doesn't exist."
+ (miniblog.db:update-entry id title content :username username :transform #'xform))
+
+(defun delete-entry (id)
+ "Delete the specified entry from the database. No-op if the id is invalid."
+ (miniblog.db:delete-entry id))
+
+(defun add-page (name title content &key (parent 0) (username "nobody"))
+ "Add a new page to the database"
+ (miniblog.db:add-page name title content :parent parent :username username :transform #'xform))
+
+(defun get-page (id)
+ "Get page by id, or NIL if the requested id isn't found"
+ (miniblog.db:get-page id :transform #'xform))
+
+(defmacro with-page-id (page id &rest body)
+ "Takes a varname to hold the entry list and a page id
+ and executes the forms in body with the entry bound
+ to the specified entry variable"
+ `(let ((,page (miniblog.db:get-page ,id)))
+ (if ,page
+ (progn ,@body)
+ (format t "Page ID ~d not found~%" ,id))))
+
+(defun get-pages (&optional (root-id 0))
+ "Get all pages in a tree, or optionally a subtree starting from a given id. Returns the subtree as the first return value and the (unconditionally) full hashtable as the second."
+ (miniblog.db:get-pages :root-id root-id :transform #'xform))
+
+(defun update-page (id name title content &key (username "nobody"))
+ "Update page by id. Returns the updated page or nil if the id doesn't exist."
+ (miniblog.db:update-page id name title content :username username :transform #'xform))
+
+(defun move-page (id parent)
+ "Move a page under a new parent page (or to the root if parent is 0 or NIL)"
+ (miniblog.db:move-page id parent :transform #'xform))
+
+(defun delete-page (id &key (children :move-to-parent))
+ "Delete a page. The parameter CHILDREN can be any of :MOVE-TO-PARENT (the default) in which all immediate children will be attached to the deleted page's parent, :MOVE-TO-ROOT in which all immediate children will be made top-level pages, or :DELETE in which case the entire subtree will be pruned."
+ (miniblog.db:delete-page id :children children))
diff --git a/src/db.lisp b/src/db.lisp
@@ -39,58 +39,24 @@
(apply #'connect-toplevel params)
(init-tables))
-(defgeneric xform (entry)
- (:documentation "Transform an entry of some type into an idiomatic p-list"))
-
-(defmethod xform ((entry blog-entries))
- "Transform a blog-entries object into an idiomatic property list"
- (list :id (mito.dao.mixin:object-id entry)
- :created-at (mito.dao.mixin:object-created-at entry)
- :last-updated-at (mito.dao.mixin:object-updated-at entry)
- :title (entry-title entry)
- :content (entry-content entry)
- :created-by (entry-username entry)
- :last-updated-by (entry-last-updated-by entry)))
-
-(defmethod xform ((entry blog-pages))
- "Transform a blog-pages object into an idiomatic p-list"
- (list :id (mito.dao.mixin:object-id entry)
- :created-at (mito.dao.mixin:object-created-at entry)
- :last-updated-at (mito.dao.mixin:object-updated-at entry)
- :name (page-name entry)
- :parent (page-parent entry)
- :title (page-title entry)
- :content (page-content entry)
- :created-by (page-username entry)
- :last-updated-by (page-last-updated-by entry)))
-
-(defun add-entry (title content &key (username "nobody"))
+(defun add-entry (title content &key (username "nobody") (transform #'identity))
"Add a new blog entry to the database"
- (xform (create-dao 'blog-entries
- :title title
- :content content
- :username username
- :last-updated-by username)))
+ (funcall transform (create-dao 'blog-entries
+ :title title
+ :content content
+ :username username
+ :last-updated-by username)))
(defun get-raw-entry (id)
(find-dao 'blog-entries :id id))
-(defun get-entry (id)
+(defun get-entry (id &key (transform #'identity))
"Get entry by id, or nil if the requested id isn't found"
(let ((entry (get-raw-entry id)))
(if entry
- (xform entry))))
-
-(defmacro with-entry-id (entry id &rest body)
- "Takes a varname to hold the entry list and a post id
- and executes the forms in body with the entry bound
- to the specified entry variable"
- `(let ((,entry (miniblog.db:get-entry ,id)))
- (if ,entry
- (progn ,@body)
- (format t "Post ID ~d not found~%" ,id))))
-
-(defun get-entries (&key year month max-entries)
+ (funcall transform entry))))
+
+(defun get-entries (&key year month max-entries (transform #'identity))
"Get entries from the database, optionally limited to a date
range or count"
(labels
@@ -121,23 +87,23 @@
(where (:and (:>= :created_at (start-range year month))
(:< :created_at (end-range year month)))))))
- (mapcar #'xform
+ (mapcar transform
(select-dao 'blog-entries
(where-clause year month)
(order-by (:desc :created_at))
(if max-entries
(limit max-entries))))))
-(defun update-entry (id title content &key (username "nobody"))
+(defun update-entry (id title content &key (username "nobody") (transform #'identity))
"Update entry by id. Returns the updated entry or nil if the id doesn't exist."
(let ((entry (get-raw-entry id)))
(if entry
- (xform (progn
- (setf (entry-title entry) title)
- (setf (entry-content entry) content)
- (setf (entry-last-updated-by entry) username)
- (save-dao entry)
- entry)))))
+ (funcall transform
+ (progn (setf (entry-title entry) title)
+ (setf (entry-content entry) content)
+ (setf (entry-last-updated-by entry) username)
+ (save-dao entry)
+ entry)))))
(defun delete-entry (id)
"Delete the specified entry from the database. No-op if the id is invalid."
@@ -145,40 +111,31 @@
(if entry
(delete-dao entry))))
-(defun add-page (name title content &key (parent 0) (username "nobody"))
+(defun add-page (name title content &key (parent 0) (username "nobody") (transform #'identity))
"Add a new page to the database"
- (xform (create-dao 'blog-pages
- :name name
- :parent parent
- :title title
- :content content
- :username username
- :last-updated-by username)))
+ (funcall transform (create-dao 'blog-pages
+ :name name
+ :parent parent
+ :title title
+ :content content
+ :username username
+ :last-updated-by username)))
(defun get-raw-page (id)
(find-dao 'blog-pages :id id))
-(defun get-page (id)
+(defun get-page (id &key (transform #'identity))
"Get page by id, or NIL if the requested id isn't found"
(let ((entry (get-raw-page id)))
(if entry
- (xform entry))))
-
-(defmacro with-page-id (page id &rest body)
- "Takes a varname to hold the entry list and a page id
- and executes the forms in body with the entry bound
- to the specified entry variable"
- `(let ((,page (miniblog.db:get-page ,id)))
- (if ,page
- (progn ,@body)
- (format t "Page ID ~d not found~%" ,id))))
-
-(defun build-tree-table (dao-list &optional (xform #'xform))
+ (funcall transform entry))))
+
+(defun build-tree-table (dao-list transform)
(let ((entry-table (make-hash-table)))
(labels ((build-tree (raw-entry)
(let ((id (mito.dao.mixin:object-id raw-entry))
(parent-id (page-parent raw-entry))
- (entry (funcall xform raw-entry)))
+ (entry (funcall transform raw-entry)))
(setf (getf entry :children)
(getf (gethash id entry-table) :children))
(setf (gethash id entry-table) entry)
@@ -188,33 +145,33 @@
(mapcar #'build-tree dao-list)
entry-table)))
-(defun get-pages (&optional (root-id 0))
+(defun get-pages (&key (root-id 0) (transform #'identity))
"Get all pages in a tree, or optionally a subtree starting from a given id. Returns the subtree as the first return value and the (unconditionally) full hashtable as the second."
- (let* ((entry-table (build-tree-table (select-dao 'blog-pages))))
+ (let* ((entry-table (build-tree-table (select-dao 'blog-pages) transform)))
(values (gethash root-id entry-table) entry-table)))
-(defun update-page (id name title content &key (username "nobody"))
+(defun update-page (id name title content &key (username "nobody") (transform #'identity))
"Update page by id. Returns the updated page or nil if the id doesn't exist."
(let ((entry (get-raw-page id)))
(if entry
- (xform (progn
- (setf (page-name entry) name)
- (setf (page-title entry) title)
- (setf (page-content entry) content)
- (setf (page-last-updated-by entry) username)
- (save-dao entry)
- entry)))))
+ (funcall transform
+ (progn (setf (page-name entry) name)
+ (setf (page-title entry) title)
+ (setf (page-content entry) content)
+ (setf (page-last-updated-by entry) username)
+ (save-dao entry)
+ entry)))))
(defun move-page-dao (entry parent)
(setf (page-parent entry) parent)
(save-dao entry)
entry)
-(defun move-page (id parent)
+(defun move-page (id parent &key (transform #'identity))
"Move a page under a new parent page (or to the root if parent is 0 or NIL)"
(let ((entry (get-raw-page id)))
(if entry
- (xform (move-page-dao entry (or parent 0))))))
+ (funcall transform (move-page-dao entry (or parent 0))))))
(defun prune-subtree (entry-table root &optional skip-top)
(if (not skip-top)
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -164,7 +164,7 @@
(let ((rss-content (miniblog.content:gen-rss-feed entries
:generator *rss-generator*
:tz *blog-timezone*))
- (pages (miniblog.db:get-pages)))
+ (pages (miniblog.data:get-pages)))
(regenerate-file (list :rss nil rss-content))
(regenerate-file (list :index nil
(miniblog.content:gen-index entries pages
@@ -177,7 +177,7 @@
:tz *blog-timezone*)))))
(defun regenerate-page-and-parent-and-children (parent-path page-id pages)
- (let* ((entries (miniblog.db:get-entries))
+ (let* ((entries (miniblog.data:get-entries))
(subtree-root (miniblog.content:get-page-by-path parent-path pages))
(archive-date-list (miniblog.content:get-archive-date-list entries
*blog-timezone*))
@@ -212,8 +212,8 @@
:archive-date-list archive-date-list)))))
(defun regenerate-all ()
- (let ((all (miniblog.content:gen-all (miniblog.db:get-entries)
- (miniblog.db:get-pages)
+ (let ((all (miniblog.content:gen-all (miniblog.data:get-entries)
+ (miniblog.data:get-pages)
:generator *generator*
:page-generator *page-generator*
:rss-generator *rss-generator*
@@ -222,7 +222,7 @@
(defun entries-in-month (year month)
"Determine number of entries in a given month and year"
- (let ((entries-in-month (miniblog.db:get-entries :year year :month month)))
+ (let ((entries-in-month (miniblog.data:get-entries :year year :month month)))
(length entries-in-month)))
(defun new-month-p (year month)
@@ -238,7 +238,7 @@
(let* ((post (miniblog.edit:get-title-and-content text))
(title (nth 0 post))
(content (nth 1 post))
- (new-entry (miniblog.db:add-entry
+ (new-entry (miniblog.data:add-entry
(or title "Untitled")
content
:username (get-username)))
@@ -248,7 +248,7 @@
(month (cdr year-month)))
(if (or regen (new-month-p year month))
(regenerate-all)
- (regenerate-index-and-given-month (miniblog.db:get-entries) year month)))
+ (regenerate-index-and-given-month (miniblog.data:get-entries) year month)))
(format t "Abandoning post...~%")))
(defmethod add-entry ((entry-type (eql :page)) uri regen)
@@ -257,13 +257,13 @@
(let* ((parent-path (butlast uri-components))
(parent-id (if parent-path
(miniblog.content:get-page-id-by-path parent-path
- (miniblog.db:get-pages))
+ (miniblog.data:get-pages))
0)))
(if-let ((text (miniblog.edit:edit-text)))
(let* ((post (miniblog.edit:get-title-and-content text))
(title (nth 0 post))
(content (nth 1 post))
- (new-entry (miniblog.db:add-page
+ (new-entry (miniblog.data:add-page
name
(or title "Untitled")
content
@@ -273,7 +273,7 @@
(regenerate-all)
(regenerate-page-and-parent-and-children parent-path
(getf new-entry :id)
- (miniblog.db:get-pages))))
+ (miniblog.data:get-pages))))
(format t "Abandoning page...~%")))
t)
(format t "Invalid page name ~a~%" uri)))
@@ -285,7 +285,7 @@
(:documentation "Get an entry of type ENTRY-TYPE with id ID"))
(defmethod get-entry ((entry-type (eql :post)) id)
- (miniblog.db:with-entry-id entry id
+ (miniblog.data:with-entry-id entry id
(format t "ID: ~d~%" (getf entry :id))
(format t "Created: ~A by ~A~%"
(date-format (getf entry :created-at)) (getf entry :created-by))
@@ -295,11 +295,11 @@
(format t "Content:~%~A~%" (getf entry :content))))
(defmethod get-entry ((entry-type (eql :page)) id)
- (miniblog.db:with-page-id page id
+ (miniblog.data:with-page-id page id
(format t "ID: ~d~%" (getf page :id))
(format t "Path: page/~a~%" (str:join "/" (miniblog.content:get-path-to-page
id
- (cadr (multiple-value-list (miniblog.db:get-pages))))))
+ (cadr (multiple-value-list (miniblog.data:get-pages))))))
(format t "Created: ~A by ~A~%"
(date-format (getf page :created-at)) (getf page :created-by))
(format t "Last updated: ~A by ~A~%"
@@ -318,13 +318,13 @@
(:documentation "Edit an entry of type ENTRY-TYPE with id ID"))
(defmethod edit-entry ((entry-type (eql :post)) id regen)
- (miniblog.db:with-entry-id entry id
+ (miniblog.data:with-entry-id entry id
(if-let ((text (miniblog.edit:edit-text
:template (make-template (getf entry :title) (getf entry :content)))))
(let* ((post (miniblog.edit:get-title-and-content text))
(title (nth 0 post))
(content (nth 1 post)))
- (miniblog.db:update-entry
+ (miniblog.data:update-entry
id title content
:username (get-username))
(let* ((created-at (getf entry :created-at))
@@ -333,22 +333,22 @@
(month (timestamp-month created-at
:timezone *blog-timezone*)))
(if (not regen)
- (regenerate-index-and-given-month (miniblog.db:get-entries) year month)
+ (regenerate-index-and-given-month (miniblog.data:get-entries) year month)
(regenerate-all))))
(format t "No change, abandoning...~%"))))
(defmethod edit-entry ((entry-type (eql :page)) id regen)
- (miniblog.db:with-page-id entry id
+ (miniblog.data:with-page-id entry id
(if-let ((text (miniblog.edit:edit-text
:template (make-template (getf entry :title) (getf entry :content)))))
(let* ((page (miniblog.edit:get-title-and-content text))
(title (nth 0 page))
(content (nth 1 page))
- (new-entry (miniblog.db:update-page
+ (new-entry (miniblog.data:update-page
id (getf entry :name) title content
:username (get-username))))
(if (not regen)
- (let* ((pages-tuple (multiple-value-list (miniblog.db:get-pages)))
+ (let* ((pages-tuple (multiple-value-list (miniblog.data:get-pages)))
(page-table (cadr pages-tuple))
(parent-id (getf new-entry :parent))
(root (gethash 0 page-table))
@@ -367,9 +367,9 @@
(defmethod delete-entry ((entry-type (eql :post)) id children-to-root regen)
(declare (ignore children-to-root))
- (miniblog.db:with-entry-id entry id
+ (miniblog.data:with-entry-id entry id
(format t "Deleting post ID ~d...~%" id)
- (miniblog.db:delete-entry id)
+ (miniblog.data:delete-entry id)
(let* ((created-at (getf entry :created-at))
(year (timestamp-year created-at
:timezone *blog-timezone*))
@@ -378,22 +378,22 @@
(flush-monthly-path year month)
(if (or regen (removed-month-p year month))
(regenerate-all)
- (regenerate-index-and-given-month (miniblog.db:get-entries) year month)))))
+ (regenerate-index-and-given-month (miniblog.data:get-entries) year month)))))
(defmethod delete-entry ((entry-type (eql :page)) id children-to-root regen)
- (miniblog.db:with-page-id page id
+ (miniblog.data:with-page-id page id
(format t "Delete page ID ~d...~%" id)
- (let* ((pages-tuple (multiple-value-list (miniblog.db:get-pages)))
+ (let* ((pages-tuple (multiple-value-list (miniblog.data:get-pages)))
(page-table (cadr pages-tuple))
(path (miniblog.content:get-path-to-page id page-table)))
- (miniblog.db:delete-page id :children (if children-to-root
- :children-to-root
- :children-to-parent))
+ (miniblog.data:delete-page id :children (if children-to-root
+ :children-to-root
+ :children-to-parent))
(flush-page-path path)
(if (or children-to-root (< (length path) 3))
(regenerate-all)
(let* ((parent-id (getf page :parent))
- (pages-tuple (multiple-value-list (miniblog.db:get-pages)))
+ (pages-tuple (multiple-value-list (miniblog.data:get-pages)))
(page-table (cadr pages-tuple))
(parent (gethash parent-id page-table))
(parent-of-parent-id (getf parent :parent))
@@ -415,9 +415,9 @@
(parent-path (butlast uri-components))
(parent-id (miniblog.content:get-page-id-by-path
parent-path
- (miniblog.db:get-pages))))
+ (miniblog.data:get-pages))))
- (miniblog.db:move-page id parent-id)
+ (miniblog.data:move-page id parent-id)
;; FIXME: Regeneration logic for moving pages is complex so
;; we're punting for now but we should avoid doing a full
;; regen unless we have to. The basic logic should look
@@ -436,7 +436,7 @@
(:documentation "List entries of type ENTRY-TYPE, possibly restricted to entries START through N. For hierarchical entry types, only START is consumed, specifying which entry to start listing from in the tree."))
(defmethod list-entries ((entry-type (eql :post)) start n)
- (let* ((entries (miniblog.db:get-entries))
+ (let* ((entries (miniblog.data:get-entries))
(first (or start 0))
(last (if n
(+ first n)
@@ -453,7 +453,7 @@
(format t "~v{~a~:*~}~a (ID ~d) - \"~a\" ~a~%" depth '(" ") name id title created-by))
(loop for entry in children
do (traverse entry (1+ depth))))))
- (let ((pages (miniblog.db:get-pages start)))
+ (let ((pages (miniblog.data:get-pages start)))
(traverse pages 0))))
(defun init-tz ()
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -13,8 +13,24 @@
(defpackage :miniblog.db
(:use :cl :mito :sxql)
- (:export #:init #:init-tables #:add-entry #:get-entry
- #:with-entry-id
+ (:export blog-entries blog-pages
+ #:entry-username #:entry-last-updated-by #:entry-title #:entry-content
+ #:page-username #:page-last-updated-by #:page-name #:page-parent
+ #:page-title #:page-content
+ #:init #:init-tables #:add-entry #:get-entry
+ #:get-entries #:update-entry #:delete-entry
+ #:add-page #:get-page
+ #:get-pages #:update-page #:delete-page
+ #:move-page))
+
+(defpackage :miniblog.data
+ (:use :cl)
+ (:import-from :miniblog.db :blog-entries :blog-pages
+ :entry-username :entry-last-updated-by :entry-title
+ :entry-content
+ :page-username :page-last-updated-by :page-name :page-parent
+ :page-title :page-content)
+ (:export #:add-entry #:get-entry #:with-entry-id
#:get-entries #:update-entry #:delete-entry
#:add-page #:get-page #:with-page-id
#:get-pages #:update-page #:delete-page
diff --git a/tst/data.lisp b/tst/data.lisp
@@ -0,0 +1,217 @@
+(in-package :miniblog/tests)
+
+(in-suite miniblog-test)
+
+(defparameter +db-settings+ '(sqlite3 :database-name ":memory:"))
+
+(test add-and-get-entry
+ "Add an entry and then fetch it back, verify all fields are correct"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((title "Test entry")
+ (content "Test content")
+ (username "test")
+ (new-entry (miniblog.data:add-entry title content :username username))
+ (now (local-time:now))
+ (new-id (getf new-entry :id))
+ (fetched-entry (miniblog.data:get-entry new-id)))
+ (is (and (string= title (getf new-entry :title))
+ (string= title (getf fetched-entry :title))))
+ (is (and (string= content (getf new-entry :content))
+ (string= content (getf fetched-entry :content))))
+ (is (and (string= username (getf new-entry :created-by))
+ (string= username (getf fetched-entry :created-by))))
+ (is (and (string= username (getf new-entry :last-updated-by))
+ (string= username (getf fetched-entry :last-updated-by))))
+ (is (and (< (timestamp-difference now (getf new-entry :created-at)) 1)
+ (>= (timestamp-difference now (getf new-entry :created-at)) 0)))
+ (is (and (timestamp= (getf new-entry :created-at)
+ (getf new-entry :last-updated-at))))
+ (is (and (timestamp= (getf new-entry :created-at)
+ (getf fetched-entry :created-at))))
+ (is (and (timestamp= (getf new-entry :last-updated-at)
+ (getf fetched-entry :last-updated-at)))))))
+
+(test modify-entry
+ "Update an entry, verify update fields"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((title "Before title")
+ (content "Before content")
+ (username "before")
+ (entry (miniblog.data:add-entry title content :username username))
+ (id (getf entry :id))
+ (new-title "After title")
+ (new-content "After content")
+ (new-username "after")
+ (updated-entry (miniblog.data:update-entry id new-title new-content :username new-username)))
+ (is (string= new-title (getf updated-entry :title)))
+ (is (string= new-content (getf updated-entry :content)))
+ (is (string= username (getf updated-entry :created-by)))
+ (is (string= new-username (getf updated-entry :last-updated-by)))
+ (is (> (timestamp-difference (getf updated-entry :last-updated-at) (getf updated-entry :created-at)) 0)))))
+
+(test delete-entry
+ "Add an entry, delete it and verify it's removed"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((entry (miniblog.data:add-entry "foo" "foo"))
+ (id (getf entry :id)))
+ (is (miniblog.data:get-entry id))
+ (miniblog.data:delete-entry id)
+ (is (not (miniblog.data:get-entry id))))))
+
+(test add-and-get-page
+ "Add a page and then fetch it back, verify all fields are correct"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((name "test")
+ (title "Test page")
+ (content "Test content")
+ (username "test")
+ (new-page (miniblog.data:add-page name title content :username username))
+ (now (local-time:now))
+ (new-id (getf new-page :id))
+ (fetched-page (miniblog.data:get-page new-id)))
+ (is (and (eql 0 (getf new-page :parent))
+ (eql 0 (getf fetched-page :parent))))
+ (is (and (string= name (getf new-page :name))
+ (string= name (getf fetched-page :name))))
+ (is (and (string= title (getf new-page :title))
+ (string= title (getf fetched-page :title))))
+ (is (and (string= content (getf new-page :content))
+ (string= content (getf fetched-page :content))))
+ (is (and (string= username (getf new-page :created-by))
+ (string= username (getf fetched-page :created-by))))
+ (is (and (string= username (getf new-page :last-updated-by))
+ (string= username (getf fetched-page :last-updated-by))))
+ (is (and (< (timestamp-difference now (getf new-page :created-at)) 1)
+ (>= (timestamp-difference now (getf new-page :created-at)) 0)))
+ (is (and (timestamp= (getf new-page :created-at)
+ (getf new-page :last-updated-at))))
+ (is (and (timestamp= (getf new-page :created-at)
+ (getf fetched-page :created-at))))
+ (is (and (timestamp= (getf new-page :last-updated-at)
+ (getf fetched-page :last-updated-at)))))))
+
+(test modify-page
+ "Update a page, verify update fields"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((name "before")
+ (title "Before title")
+ (content "Before content")
+ (username "before")
+ (page (miniblog.data:add-page name title content :username username))
+ (id (getf page :id))
+ (new-name "after")
+ (new-title "After title")
+ (new-content "After content")
+ (new-username "after")
+ (updated-page (miniblog.data:update-page id new-name new-title new-content :username new-username)))
+ (is (eql 0 (getf updated-page :parent)))
+ (is (string= new-title (getf updated-page :title)))
+ (is (string= new-content (getf updated-page :content)))
+ (is (string= username (getf updated-page :created-by)))
+ (is (string= new-username (getf updated-page :last-updated-by)))
+ (is (> (timestamp-difference (getf updated-page :last-updated-at) (getf updated-page :created-at)) 0)))))
+
+(test move-page
+ "Create several test pages, move one in the hierarchy and verify the move"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.data:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.data:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.data:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id))
+ (moved-page-2 (miniblog.data:move-page page-2-id 0))
+ (page-3-post-move (miniblog.data:get-page page-3-id)))
+ (is (eql page-1-id (getf page-2 :parent)))
+ (is (eql 0 (getf moved-page-2 :parent)))
+ (is (and (eql page-2-id (getf page-3 :parent))
+ (eql page-2-id (getf page-3-post-move :parent)))))))
+
+(test delete-page
+ "Add a page, delete it and verify it's removed"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page (miniblog.data:add-page "foo" "foo" "foo"))
+ (id (getf page :id)))
+ (is (miniblog.data:get-page id))
+ (miniblog.data:delete-page id)
+ (is (not (miniblog.data:get-page id))))))
+
+(test delete-page-moving-subtree-to-root
+ "Add a page with a child, delete it and verify that it's removed and its child is reparented to the root"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.data:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.data:add-page "bar" "bar" "bar" :parent (getf page-1 :id)))
+ (page-2-id (getf page-2 :id)))
+ (miniblog.data:delete-page page-1-id :children :move-to-root)
+ (is (not (miniblog.data:get-page page-1-id)))
+ (is (eql 0 (getf (miniblog.data:get-page page-2-id) :parent))))))
+
+(test delete-page-moving-subtree-to-parent
+ "Add three test pages, each the next one's parent, delete the second one and verify that it's removed and its child is reparented to first page"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.data:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.data:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.data:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id)))
+ (miniblog.data:delete-page page-2-id) ; :MOVE-TO-PARENT is default
+ (is (eql page-1-id (getf (miniblog.data:get-page page-3-id) :parent))))))
+
+(test delete-page-deleting-subtree
+ "Add six test pages with the first the second's parent and the second the top of a subtree containing the other four, delete the second one and verify that it's removed and all its children are as well"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.data:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.data:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.data:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id))
+ (page-4 (miniblog.data:add-page "quux" "quux" "quux" :parent page-3-id))
+ (page-4-id (getf page-4 :id))
+ (page-5 (miniblog.data:add-page "wibble" "wibble" "wibble" :parent page-2-id))
+ (page-5-id (getf page-5 :id))
+ (page-6 (miniblog.data:add-page "frotz" "frotz" "frotz" :parent page-5-id))
+ (page-6-id (getf page-6 :id)))
+ (miniblog.data:delete-page page-2-id :children :delete)
+ (is (and (not (miniblog.data:get-page page-3-id)))
+ (not (miniblog.data:get-page page-4-id))
+ (not (miniblog.data:get-page page-5-id))
+ (not (miniblog.data:get-page page-6-id))))))
+
+(test get-pages
+ "Add a tree of pages and verify that get-pages returns the tree as constructed"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.data:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.data:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.data:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id))
+ (page-4 (miniblog.data:add-page "quux" "quux" "quux" :parent page-3-id))
+ (page-4-id (getf page-4 :id))
+ (page-5 (miniblog.data:add-page "wibble" "wibble" "wibble" :parent page-2-id))
+ (page-5-id (getf page-5 :id))
+ (pages (miniblog.data:get-pages))
+ (maybe-page-1 (car (getf pages :children)))
+ (maybe-page-2 (car (getf maybe-page-1 :children)))
+ (maybe-page-3 (cadr (getf maybe-page-2 :children)))
+ (maybe-page-4 (car (getf maybe-page-3 :children)))
+ (maybe-page-5 (car (getf maybe-page-2 :children))))
+ (is (eql page-1-id (getf maybe-page-1 :id)))
+ (is (eql page-2-id (getf maybe-page-2 :id)))
+ (is (eql page-3-id (getf maybe-page-3 :id)))
+ (is (eql page-4-id (getf maybe-page-4 :id)))
+ (is (eql page-5-id (getf maybe-page-5 :id))))))
diff --git a/tst/db.lisp b/tst/db.lisp
@@ -1,217 +0,0 @@
-(in-package :miniblog/tests)
-
-(in-suite miniblog-test)
-
-(defparameter +db-settings+ '(sqlite3 :database-name ":memory:"))
-
-(test add-and-get-entry
- "Add an entry and then fetch it back, verify all fields are correct"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((title "Test entry")
- (content "Test content")
- (username "test")
- (new-entry (miniblog.db:add-entry title content :username username))
- (now (local-time:now))
- (new-id (getf new-entry :id))
- (fetched-entry (miniblog.db:get-entry new-id)))
- (is (and (string= title (getf new-entry :title))
- (string= title (getf fetched-entry :title))))
- (is (and (string= content (getf new-entry :content))
- (string= content (getf fetched-entry :content))))
- (is (and (string= username (getf new-entry :created-by))
- (string= username (getf fetched-entry :created-by))))
- (is (and (string= username (getf new-entry :last-updated-by))
- (string= username (getf fetched-entry :last-updated-by))))
- (is (and (< (timestamp-difference now (getf new-entry :created-at)) 1)
- (>= (timestamp-difference now (getf new-entry :created-at)) 0)))
- (is (and (timestamp= (getf new-entry :created-at)
- (getf new-entry :last-updated-at))))
- (is (and (timestamp= (getf new-entry :created-at)
- (getf fetched-entry :created-at))))
- (is (and (timestamp= (getf new-entry :last-updated-at)
- (getf fetched-entry :last-updated-at)))))))
-
-(test modify-entry
- "Update an entry, verify update fields"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((title "Before title")
- (content "Before content")
- (username "before")
- (entry (miniblog.db:add-entry title content :username username))
- (id (getf entry :id))
- (new-title "After title")
- (new-content "After content")
- (new-username "after")
- (updated-entry (miniblog.db:update-entry id new-title new-content :username new-username)))
- (is (string= new-title (getf updated-entry :title)))
- (is (string= new-content (getf updated-entry :content)))
- (is (string= username (getf updated-entry :created-by)))
- (is (string= new-username (getf updated-entry :last-updated-by)))
- (is (> (timestamp-difference (getf updated-entry :last-updated-at) (getf updated-entry :created-at)) 0)))))
-
-(test delete-entry
- "Add an entry, delete it and verify it's removed"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((entry (miniblog.db:add-entry "foo" "foo"))
- (id (getf entry :id)))
- (is (miniblog.db:get-entry id))
- (miniblog.db:delete-entry id)
- (is (not (miniblog.db:get-entry id))))))
-
-(test add-and-get-page
- "Add a page and then fetch it back, verify all fields are correct"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((name "test")
- (title "Test page")
- (content "Test content")
- (username "test")
- (new-page (miniblog.db:add-page name title content :username username))
- (now (local-time:now))
- (new-id (getf new-page :id))
- (fetched-page (miniblog.db:get-page new-id)))
- (is (and (eql 0 (getf new-page :parent))
- (eql 0 (getf fetched-page :parent))))
- (is (and (string= name (getf new-page :name))
- (string= name (getf fetched-page :name))))
- (is (and (string= title (getf new-page :title))
- (string= title (getf fetched-page :title))))
- (is (and (string= content (getf new-page :content))
- (string= content (getf fetched-page :content))))
- (is (and (string= username (getf new-page :created-by))
- (string= username (getf fetched-page :created-by))))
- (is (and (string= username (getf new-page :last-updated-by))
- (string= username (getf fetched-page :last-updated-by))))
- (is (and (< (timestamp-difference now (getf new-page :created-at)) 1)
- (>= (timestamp-difference now (getf new-page :created-at)) 0)))
- (is (and (timestamp= (getf new-page :created-at)
- (getf new-page :last-updated-at))))
- (is (and (timestamp= (getf new-page :created-at)
- (getf fetched-page :created-at))))
- (is (and (timestamp= (getf new-page :last-updated-at)
- (getf fetched-page :last-updated-at)))))))
-
-(test modify-page
- "Update a page, verify update fields"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((name "before")
- (title "Before title")
- (content "Before content")
- (username "before")
- (page (miniblog.db:add-page name title content :username username))
- (id (getf page :id))
- (new-name "after")
- (new-title "After title")
- (new-content "After content")
- (new-username "after")
- (updated-page (miniblog.db:update-page id new-name new-title new-content :username new-username)))
- (is (eql 0 (getf updated-page :parent)))
- (is (string= new-title (getf updated-page :title)))
- (is (string= new-content (getf updated-page :content)))
- (is (string= username (getf updated-page :created-by)))
- (is (string= new-username (getf updated-page :last-updated-by)))
- (is (> (timestamp-difference (getf updated-page :last-updated-at) (getf updated-page :created-at)) 0)))))
-
-(test move-page
- "Create several test pages, move one in the hierarchy and verify the move"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
- (page-1-id (getf page-1 :id))
- (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
- (page-2-id (getf page-2 :id))
- (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
- (page-3-id (getf page-3 :id))
- (moved-page-2 (miniblog.db:move-page page-2-id 0))
- (page-3-post-move (miniblog.db:get-page page-3-id)))
- (is (eql page-1-id (getf page-2 :parent)))
- (is (eql 0 (getf moved-page-2 :parent)))
- (is (and (eql page-2-id (getf page-3 :parent))
- (eql page-2-id (getf page-3-post-move :parent)))))))
-
-(test delete-page
- "Add a page, delete it and verify it's removed"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((page (miniblog.db:add-page "foo" "foo" "foo"))
- (id (getf page :id)))
- (is (miniblog.db:get-page id))
- (miniblog.db:delete-page id)
- (is (not (miniblog.db:get-page id))))))
-
-(test delete-page-moving-subtree-to-root
- "Add a page with a child, delete it and verify that it's removed and its child is reparented to the root"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
- (page-1-id (getf page-1 :id))
- (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent (getf page-1 :id)))
- (page-2-id (getf page-2 :id)))
- (miniblog.db:delete-page page-1-id :children :move-to-root)
- (is (not (miniblog.db:get-page page-1-id)))
- (is (eql 0 (getf (miniblog.db:get-page page-2-id) :parent))))))
-
-(test delete-page-moving-subtree-to-parent
- "Add three test pages, each the next one's parent, delete the second one and verify that it's removed and its child is reparented to first page"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
- (page-1-id (getf page-1 :id))
- (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
- (page-2-id (getf page-2 :id))
- (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
- (page-3-id (getf page-3 :id)))
- (miniblog.db:delete-page page-2-id) ; :MOVE-TO-PARENT is default
- (is (eql page-1-id (getf (miniblog.db:get-page page-3-id) :parent))))))
-
-(test delete-page-deleting-subtree
- "Add six test pages with the first the second's parent and the second the top of a subtree containing the other four, delete the second one and verify that it's removed and all its children are as well"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
- (page-1-id (getf page-1 :id))
- (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
- (page-2-id (getf page-2 :id))
- (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
- (page-3-id (getf page-3 :id))
- (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id))
- (page-4-id (getf page-4 :id))
- (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id))
- (page-5-id (getf page-5 :id))
- (page-6 (miniblog.db:add-page "frotz" "frotz" "frotz" :parent page-5-id))
- (page-6-id (getf page-6 :id)))
- (miniblog.db:delete-page page-2-id :children :delete)
- (is (and (not (miniblog.db:get-page page-3-id)))
- (not (miniblog.db:get-page page-4-id))
- (not (miniblog.db:get-page page-5-id))
- (not (miniblog.db:get-page page-6-id))))))
-
-(test get-pages
- "Add a tree of pages and verify that get-pages returns the tree as constructed"
- (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
- (miniblog.db:init-tables)
- (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
- (page-1-id (getf page-1 :id))
- (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
- (page-2-id (getf page-2 :id))
- (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
- (page-3-id (getf page-3 :id))
- (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id))
- (page-4-id (getf page-4 :id))
- (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id))
- (page-5-id (getf page-5 :id))
- (pages (miniblog.db:get-pages))
- (maybe-page-1 (car (getf pages :children)))
- (maybe-page-2 (car (getf maybe-page-1 :children)))
- (maybe-page-3 (cadr (getf maybe-page-2 :children)))
- (maybe-page-4 (car (getf maybe-page-3 :children)))
- (maybe-page-5 (car (getf maybe-page-2 :children))))
- (is (eql page-1-id (getf maybe-page-1 :id)))
- (is (eql page-2-id (getf maybe-page-2 :id)))
- (is (eql page-3-id (getf maybe-page-3 :id)))
- (is (eql page-4-id (getf maybe-page-4 :id)))
- (is (eql page-5-id (getf maybe-page-5 :id))))))
