commit 4c63d794755e2a468c984f84b9c7103eceb638d7
parent 8d23feb581cf0a59780e0df3dabc140fd5a59e77
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Sat, 17 Feb 2024 23:15:34 -0800
Basic support for drafts
Drafts can now be created, edited, published, posts can be unpublished
to drafts, etc. There are improvements that still need to be made,
especially in handling page drafts (since right now there's no logic for
handling drafts in the page tree so the behavior of unpublishing a page
with children is undefined and almost certainly broken)
Diffstat:
4 files changed, 66 insertions(+), 39 deletions(-)
diff --git a/src/data.lisp b/src/data.lisp
@@ -65,14 +65,22 @@
(progn ,@body)
(format t "Post ID ~d not found~%" ,id))))
+(defun get-drafts ()
+ "Get all drafts. Returns (VALUES [list of draft posts] [list of draft pages])."
+ (values
+ (miniblog.db:get-entries :drafts :drafts-only :transform #'xform)
+ (miniblog.db:get-pages :drafts :drafts-only :transform #'xform)))
+
(defun get-entries (&key year month max-entries include-drafts-p)
"Get entries from the database, optionally limited to a date
range or count"
- (miniblog.db:get-entries :year year :month month :include-drafts-p include-drafts-p :max-entries max-entries :transform #'xform))
+ (miniblog.db:get-entries :year year :month month :drafts include-drafts-p :max-entries max-entries :transform #'xform))
-(defun update-entry (id title content &key rendered-content (username "nobody") draftp)
+(defun update-entry (id title content &key rendered-content (username "nobody") draftp reset-timestamp-p)
"Update entry by id. Returns the updated entry or nil if the id doesn't exist."
- (miniblog.db:update-entry id title content :rendered-content rendered-content :draftp draftp :username username :transform #'xform))
+ (miniblog.db:update-entry id title content
+ :rendered-content rendered-content :draftp draftp :reset-timestamp-p reset-timestamp-p
+ :username username :transform #'xform))
(defun update-entry-rendered-content (id rendered-content &key (username "nobody"))
"Updated entry RENDERED-CONTENT by ID. Returns the updated page or NIL if ID doesn't exist."
@@ -101,11 +109,13 @@
(defun get-pages (&key (root-id 0) include-drafts-p)
"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 :include-drafts-p include-drafts-p :transform #'xform))
+ (miniblog.db:get-pages :root-id root-id :drafts include-drafts-p :transform #'xform))
-(defun update-page (id name title content &key rendered-content (username "nobody") draftp)
+(defun update-page (id name title content &key rendered-content (username "nobody") draftp reset-timestamp-p)
"Update page by id. Returns the updated page or nil if the id doesn't exist."
- (miniblog.db:update-page id name title content :rendered-content rendered-content :username username :transform #'xform :draftp draftp))
+ (miniblog.db:update-page id name title content
+ :rendered-content rendered-content :draftp draftp :reset-timestamp-p reset-timestamp-p
+ :username username :transform #'xform ))
(defun update-page-rendered-content (id rendered-content &key (username "nobody"))
"Updated page RENDERED-CONTENT by ID. Returns the updated page or NIL if ID doesn't exist."
diff --git a/src/db.lisp b/src/db.lisp
@@ -71,7 +71,7 @@
(if entry
(funcall transform entry))))
-(defun get-entries (&key year month max-entries (transform #'identity) include-drafts-p)
+(defun get-entries (&key year month max-entries (transform #'identity) drafts)
"Get entries from the database, optionally limited to a date
range or count"
(labels
@@ -101,8 +101,9 @@
(let ((date-clauses (when (or year month)
`((:>= :created_at ,(start-range year month))
(:< :created_at ,(end-range year month)))))
- (drafts-clause (when (not include-drafts-p)
- '((:= :draftp "false")))))
+ (drafts-clause (typecase drafts
+ ((eql :drafts-only) '((:= :draftp "true")))
+ (null '((:= :draftp "false"))))))
(if (or date-clauses drafts-clause)
(where `(:and ,@date-clauses ,@drafts-clause))))))
@@ -113,7 +114,7 @@
(if max-entries
(limit max-entries))))))
-(defun update-entry (id title content &key rendered-content (username "nobody") (transform #'identity) draftp)
+(defun update-entry (id title content &key rendered-content (username "nobody") (transform #'identity) draftp reset-timestamp-p)
"Update entry by id. Returns the updated entry or nil if the id doesn't exist."
(let ((entry (get-raw-entry id)))
(if entry
@@ -123,6 +124,8 @@
(setf (entry-rendered-content entry) rendered-content)
(setf (entry-last-updated-by entry) username)
(setf (entry-draftp entry) (as-sql-bool draftp))
+ (when reset-timestamp-p
+ (setf (mito.dao.mixin:object-created-at entry) (local-time:now))) ; FIXME: This is a horrible abuse of Mito
(save-dao entry)
entry)))))
@@ -178,17 +181,19 @@
(mapcar #'build-tree dao-list)
entry-table)))
-(defun get-pages (&key (root-id 0) (transform #'identity) include-drafts-p)
+(defun get-pages (&key (root-id 0) (transform #'identity) drafts)
"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
- (if include-drafts-p
- (select-dao 'blog-pages)
- (select-dao 'blog-pages
- (where (:= :draftp "false"))))
+ (typecase drafts
+ ((eql :drafts-only) (select-dao 'blog-pages
+ (where (:= :draftp "true"))))
+ (null (select-dao 'blog-pages
+ (where (:= :draftp "false"))))
+ (t (select-dao 'blog-pages)))
transform)))
(values (gethash root-id entry-table) entry-table)))
-(defun update-page (id name title content &key rendered-content (username "nobody") (transform #'identity) draftp)
+(defun update-page (id name title content &key rendered-content (username "nobody") (transform #'identity) draftp reset-timestamp-p)
"Update page by id. Returns the updated page or nil if the id doesn't exist."
(let ((entry (get-raw-page id)))
(if entry
@@ -198,6 +203,8 @@
(setf (page-content entry) content)
(setf (page-rendered-content entry) rendered-content)
(setf (page-last-updated-by entry) username)
+ (when reset-timestamp-p
+ (setf (mito.dao.mixin:object-created-at entry) (local-time:now))) ; FIXME: This is a horrible abuse of Mito
(setf (page-draftp entry) (as-sql-bool draftp))
(save-dao entry)
entry)))))
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -49,6 +49,7 @@
((#\n) :type integer :optional t
:documentation "When listing posts, max number of posts to list (default all)")
(("page" #\p) :type boolean :optional t :documentation "This parameter specifies operations to be done on pages, rather than posts. EG saying -a -p means you intend to add a new page rather than a new post. Page IDs are in a separate namespace from post IDs.")
+ (("draft" #\f) :type boolean :optional t :documentation "When specified for adding or editing a post, this will set the post as a draft. If the post is already published and this is specified, the post will be unpublished back to the drafts.")
(("move" #\m) :type integer :optional t :documentation "Move a page from its current path to a new one.")
(("uri" #\u) :type string :optional t :documentation "When adding a new page, this specifies the path to the new page in relative URI format. For instance, \"-a -p -u foo/bar\" would specify that the new page should be created with the name bar as a child of page foo. This is only valid if root page foo actually exists. This is also used in conjunction with -m to specify the target path for the page being moved, with the same restriction. A leading / will be ignored so \"-u /foo/bar/baz\" and \"-u foo/bar/baz\" mean the same thing.")
(("children-to-root" #\c) :type boolean :optional t :documentation "When deleting a page, normally child pages of the page being deleted will be moved to the parent page of the deleted page. If -c is specified, the pages will instead be moved to the root.")
@@ -233,10 +234,10 @@
"Determine if there is only one entry in a given month and year"
(eql (entries-in-month year month) 1))
-(defgeneric add-entry (entry-type uri regen)
+(defgeneric add-entry (entry-type draft uri regen)
(:documentation "Add a new entry of type ENTRY-TYPE. URI specifies the logical location of the new entry which is only valid for certain entry types."))
-(defmethod add-entry ((entry-type (eql :post)) uri regen)
+(defmethod add-entry ((entry-type (eql :post)) draft uri regen)
(declare (ignore uri))
(if-let ((text (miniblog.edit:edit-text)))
(let* ((post (miniblog.edit:get-title-and-content text))
@@ -245,6 +246,7 @@
(new-entry (miniblog.data:add-entry
(or title "Untitled")
content
+ :draftp draft
:rendered-content (miniblog.format:markdown content)
:username (get-username)))
(year-month (miniblog.content:year-month-of-entry new-entry))
@@ -255,7 +257,7 @@
(regenerate-index-and-given-month (miniblog.data:get-entries) year month)))
(format t "Abandoning post...~%")))
-(defmethod add-entry ((entry-type (eql :page)) uri regen)
+(defmethod add-entry ((entry-type (eql :page)) draft uri regen)
(or (when-let* ((uri-components (str:split "/" uri))
(name (car (last uri-components))))
(let* ((parent-path (butlast uri-components))
@@ -271,6 +273,7 @@
name
(or title "Untitled")
content
+ :draftp draft
:rendered-content (miniblog.format:markdown content)
:parent parent-id
:username (get-username))))
@@ -291,7 +294,7 @@
(defmethod get-entry ((entry-type (eql :post)) id)
(miniblog.data:with-entry-id entry id
- (format t "ID: ~d~%" (getf entry :id))
+ (format t "ID: ~d~@[~* (DRAFT)~]~%" (getf entry :id) (getf entry :draftp))
(format t "Created: ~A by ~A~%"
(date-format (getf entry :created-at)) (getf entry :created-by))
(format t "Last updated: ~A by ~A~%"
@@ -301,7 +304,7 @@
(defmethod get-entry ((entry-type (eql :page)) id)
(miniblog.data:with-page-id page id
- (format t "ID: ~d~%" (getf page :id))
+ (format t "ID: ~d~@[~* (DRAFT)~]~%" (getf page :id) (getf page :draftp))
(format t "Path: page/~a~%" (str:join "/" (miniblog.content:get-path-to-page
id
(cadr (multiple-value-list (miniblog.data:get-pages))))))
@@ -319,40 +322,46 @@
(terpri out)
(princ content out)))
-(defgeneric edit-entry (entry-type id regen)
+(defgeneric edit-entry (entry-type id draftp regen)
(:documentation "Edit an entry of type ENTRY-TYPE with id ID"))
-(defmethod edit-entry ((entry-type (eql :post)) id regen)
+(defmethod edit-entry ((entry-type (eql :post)) id draftp regen)
(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))
+ (let* ((was-draft-p (getf entry :draftp))
+ (post (miniblog.edit:get-title-and-content text))
(title (nth 0 post))
(content (nth 1 post)))
(miniblog.data:update-entry
id title content
:rendered-content (miniblog.format:markdown content)
- :username (get-username))
+ :username (get-username)
+ :draftp draftp
+ :reset-timestamp-p (and was-draft-p (not draftp)))
(let* ((created-at (getf entry :created-at))
(year (timestamp-year created-at))
(month (timestamp-month created-at)))
- (if (not regen)
+ (if (and (not regen) (eql draftp was-draft-p))
(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)
+(defmethod edit-entry ((entry-type (eql :page)) id draftp regen)
(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))
+ (let* ((was-draft-p (getf entry :draftp))
+ (page (miniblog.edit:get-title-and-content text))
(title (nth 0 page))
(content (nth 1 page))
(new-entry (miniblog.data:update-page
id (getf entry :name) title content
:rendered-content (miniblog.format:markdown content)
- :username (get-username))))
- (if (not regen)
+ :username (get-username)
+ :draftp draftp
+ :reset-timestamp-p (and was-draft-p (not draftp)))))
+ (if (and (not regen) (eql draftp was-draft-p))
(let* ((pages-tuple (multiple-value-list (miniblog.data:get-pages)))
(page-table (cadr pages-tuple))
(parent-id (getf new-entry :parent))
@@ -439,24 +448,24 @@
(: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.data:get-entries))
+ (let* ((entries (miniblog.data:get-entries :include-drafts-p t))
(first (or start 0))
(last (if n
(+ first n)
(length entries))))
(dolist (entry (subseq entries first last))
- (format t "~d \"~a\" ~a~%" (getf entry :id) (getf entry :title) (getf entry :created-by)))))
+ (format t "~d ~@[~*(DRAFT) ~]- \"~a\" ~a~%" (getf entry :id) (getf entry :draftp) (getf entry :title) (getf entry :created-by)))))
(defmethod list-entries ((entry-type (eql :page)) start n)
(declare (ignore n))
(labels ((traverse (node depth)
- (destructuring-bind (&key id name title children created-by &allow-other-keys)
+ (destructuring-bind (&key id name title children created-by draftp &allow-other-keys)
node
(if (not (or (null id) (= id 0)))
- (format t "~v{~a~:*~}~a (ID ~d) - \"~a\" ~a~%" depth '(" ") name id title created-by))
+ (format t "~v{~a~:*~}~a (ID ~d) ~@[~*(DRAFT) ~]- \"~a\" ~a~%" depth '(" ") name id draftp title created-by))
(loop for entry in children
do (traverse entry (1+ depth))))))
- (let ((pages (miniblog.data:get-pages :root-id start)))
+ (let ((pages (miniblog.data:get-pages :root-id start :include-drafts-p t)))
(traverse pages 0))))
(defun init-tz ()
@@ -489,15 +498,15 @@
(set-config-and-defaults)
(make-generators))
-(defun miniblog (&key add get edit delete list (start 0) n page move uri children-to-root regen-all help)
+(defun miniblog (&key add get edit delete list (start 0) n page draft move uri children-to-root regen-all help)
(declare (ignore help))
(initialize)
(apply #'miniblog.db:init *db-config*)
(let ((*default-timezone* *blog-timezone*)
(entry-type (if page :page :post)))
- (cond (add (add-entry entry-type uri regen-all))
+ (cond (add (add-entry entry-type draft uri regen-all))
(get (get-entry entry-type get))
- (edit (edit-entry entry-type edit regen-all))
+ (edit (edit-entry entry-type edit draft regen-all))
(delete (delete-entry entry-type delete children-to-root regen-all))
(list (list-entries entry-type start n))
(move (move-entry entry-type move uri regen-all))
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -42,7 +42,8 @@
#:get-entries #:update-entry #:update-entry-rendered-content #:delete-entry
#:add-page #:get-page #:with-page-id
#:get-pages #:update-page #:update-page-rendered-content #:delete-page
- #:move-page))
+ #:move-page
+ #:get-drafts))
(defpackage :miniblog.content
(:use :cl :local-time :str)
