commit 8d23feb581cf0a59780e0df3dabc140fd5a59e77
parent 632728767d80e8ec81c958bb61aa12885b8aa60f
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Sat, 17 Feb 2024 21:05:37 -0800
Prerender content
As a performance and resource improvement, prerender post HTML and store
it in the database instead of rendering at load time. Also includes some
basic initial functionality to support draft post/pages
Diffstat:
9 files changed, 179 insertions(+), 89 deletions(-)
diff --git a/src/content.lisp b/src/content.lisp
@@ -8,42 +8,56 @@
(defvar *page-template* (compile-template* "page.dtl"))
(defvar *rss-template* (compile-template* "rss.dtl")))
+(defun augment-with-rendered-content (entry-obj)
+ (if (not (getf entry-obj :rendered-content))
+ (let ((content (getf entry-obj :content))
+ (augmented-entry (copy-list entry-obj)))
+ (setf (getf augmented-entry :rendered-content) (miniblog.format:markdown content))
+ augmented-entry)
+ entry-obj))
+
+(defun augment-posts-with-rendered-content (posts)
+ (loop for post in posts
+ collect (augment-with-rendered-content post)))
+
(defun render-posts (posts pages &key stream title root-uri header links
- stylesheet year month archive-date-list
- enable-rss twitter-card collapse-posts-p)
- (render-template* *posts-template* stream
- :posts posts
- :pages pages
- :title title
- :root-uri root-uri
- :header header
- :links links
- :stylesheet stylesheet
- :year year
- :month month
- :archive-date-list archive-date-list
- :enable-rss enable-rss
- :twitter-card twitter-card
- :collapse-posts-p collapse-posts-p))
+ stylesheet year month archive-date-list
+ enable-rss twitter-card collapse-posts-p)
+ (let ((posts (augment-posts-with-rendered-content posts)))
+ (render-template* *posts-template* stream
+ :posts posts
+ :pages pages
+ :title title
+ :root-uri root-uri
+ :header header
+ :links links
+ :stylesheet stylesheet
+ :year year
+ :month month
+ :archive-date-list archive-date-list
+ :enable-rss enable-rss
+ :twitter-card twitter-card
+ :collapse-posts-p collapse-posts-p)))
(defun render-page (page path pages &key stream title root-uri header links
- stylesheet year month
- archive-date-list enable-rss
- twitter-card)
- (render-template* *page-template* stream
- :page page
- :path path
- :pages pages
- :title title
- :root-uri root-uri
- :header header
- :links links
- :stylesheet stylesheet
- :year year
- :month month
- :archive-date-list archive-date-list
- :enable-rss enable-rss
- :twitter-card twitter-card))
+ stylesheet year month
+ archive-date-list enable-rss
+ twitter-card)
+ (let ((page (augment-with-rendered-content page)))
+ (render-template* *page-template* stream
+ :page page
+ :path path
+ :pages pages
+ :title title
+ :root-uri root-uri
+ :header header
+ :links links
+ :stylesheet stylesheet
+ :year year
+ :month month
+ :archive-date-list archive-date-list
+ :enable-rss enable-rss
+ :twitter-card twitter-card)))
(defun render-rss (posts &key stream title link description image-url language
copyright managing-editor webmaster category)
diff --git a/src/data.lisp b/src/data.lisp
@@ -28,7 +28,9 @@
:last-updated-at (mito.dao.mixin:object-updated-at entry)
:title (entry-title entry)
:content (entry-content entry)
+ :rendered-content (entry-rendered-content entry)
:created-by (entry-username entry)
+ :draftp (entry-draftp entry)
:last-updated-by (entry-last-updated-by entry)
:link (format-post-link entry))))
@@ -42,11 +44,13 @@
:parent (page-parent entry)
:title (page-title entry)
:content (page-content entry)
+ :rendered-content (page-rendered-content entry)
+ :draftp (page-draftp 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 add-entry (title content &key rendered-content (username "nobody") draftp)
+ (miniblog.db:add-entry title content :rendered-content rendered-content :draftp draftp :username username :transform #'xform))
(defun get-entry (id)
"Get entry by id, or nil if the requested id isn't found"
@@ -61,22 +65,26 @@
(progn ,@body)
(format t "Post ID ~d not found~%" ,id))))
-(defun get-entries (&key year month max-entries)
+(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 :max-entries max-entries :transform #'xform))
+ (miniblog.db:get-entries :year year :month month :include-drafts-p include-drafts-p :max-entries max-entries :transform #'xform))
-(defun update-entry (id title content &key (username "nobody"))
+(defun update-entry (id title content &key rendered-content (username "nobody") draftp)
"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))
+ (miniblog.db:update-entry id title content :rendered-content rendered-content :draftp draftp :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."
+ (miniblog.db:update-entry-rendered-content id rendered-content :username username))
(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"))
+(defun add-page (name title content &key (parent 0) rendered-content (username "nobody") draftp)
"Add a new page to the database"
- (miniblog.db:add-page name title content :parent parent :username username :transform #'xform))
+ (miniblog.db:add-page name title content :parent parent :rendered-content rendered-content :draftp draftp :username username :transform #'xform))
(defun get-page (id)
"Get page by id, or NIL if the requested id isn't found"
@@ -91,13 +99,17 @@
(progn ,@body)
(format t "Page ID ~d not found~%" ,id))))
-(defun get-pages (&optional (root-id 0))
+(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 :transform #'xform))
+ (miniblog.db:get-pages :root-id root-id :include-drafts-p include-drafts-p :transform #'xform))
-(defun update-page (id name title content &key (username "nobody"))
+(defun update-page (id name title content &key rendered-content (username "nobody") draftp)
"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))
+ (miniblog.db:update-page id name title content :rendered-content rendered-content :username username :transform #'xform :draftp draftp))
+
+(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."
+ (miniblog.db:update-page-rendered-content id rendered-content :username username))
(defun move-page (id parent)
"Move a page under a new parent page (or to the root if parent is 0 or NIL)"
diff --git a/src/db.lisp b/src/db.lisp
@@ -8,7 +8,11 @@
(title :col-type (:varchar 200)
:accessor entry-title)
(content :col-type (:varchar 16384)
- :accessor entry-content))
+ :accessor entry-content)
+ (rendered-content :col-type (or (:varchar 32768) :null)
+ :accessor entry-rendered-content)
+ (draftp :col-type :boolean
+ :accessor entry-draftp))
(:metaclass mito:dao-table-class))
(defclass blog-pages ()
@@ -23,7 +27,11 @@
(title :col-type (:varchar 200)
:accessor page-title)
(content :col-type (:varchar 16384)
- :accessor page-content))
+ :accessor page-content)
+ (rendered-content :col-type (or (:varchar 32768) :null)
+ :accessor page-rendered-content)
+ (draftp :col-type :boolean
+ :accessor page-draftp))
(:metaclass mito:dao-table-class)
(:unique-keys (parent name)))
@@ -39,13 +47,20 @@
(apply #'connect-toplevel params)
(init-tables))
-(defun add-entry (title content &key (username "nobody") (transform #'identity))
+(defun as-sql-bool (bool)
+ (if bool
+ t
+ 'nil))
+
+(defun add-entry (title content &key rendered-content (username "nobody") (transform #'identity) draftp)
"Add a new blog entry to the database"
(funcall transform (create-dao 'blog-entries
:title title
:content content
+ :rendered-content rendered-content
:username username
- :last-updated-by username)))
+ :last-updated-by username
+ :draftp (as-sql-bool draftp))))
(defun get-raw-entry (id)
(find-dao 'blog-entries :id id))
@@ -56,7 +71,7 @@
(if entry
(funcall transform entry))))
-(defun get-entries (&key year month max-entries (transform #'identity))
+(defun get-entries (&key year month max-entries (transform #'identity) include-drafts-p)
"Get entries from the database, optionally limited to a date
range or count"
(labels
@@ -83,9 +98,13 @@
(format nil "~d-~2,'0d-~2,'0d" end-year end-month 1)))
(where-clause (year month)
- (if (or year month)
- (where (:and (:>= :created_at (start-range year month))
- (:< :created_at (end-range year month)))))))
+ (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")))))
+ (if (or date-clauses drafts-clause)
+ (where `(:and ,@date-clauses ,@drafts-clause))))))
(mapcar transform
(select-dao 'blog-entries
@@ -94,30 +113,44 @@
(if max-entries
(limit max-entries))))))
-(defun update-entry (id title content &key (username "nobody") (transform #'identity))
+(defun update-entry (id title content &key rendered-content (username "nobody") (transform #'identity) draftp)
"Update entry by id. Returns the updated entry or nil if the id doesn't exist."
(let ((entry (get-raw-entry id)))
(if entry
(funcall transform
(progn (setf (entry-title entry) title)
(setf (entry-content entry) content)
+ (setf (entry-rendered-content entry) rendered-content)
(setf (entry-last-updated-by entry) username)
+ (setf (entry-draftp entry) (as-sql-bool draftp))
(save-dao entry)
entry)))))
+(defun update-entry-rendered-content (id rendered-content &key (username "nobody") (transform #'identity))
+ "Updated just the rendered content for an entry by ID. Returns the updated entry or NIL if ID doesn't exist."
+ (let ((entry (get-raw-entry id)))
+ (if entry
+ (funcall transform
+ (progn (setf (entry-rendered-content entry) rendered-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."
(let ((entry (get-raw-entry id)))
(if entry
(delete-dao entry))))
-(defun add-page (name title content &key (parent 0) (username "nobody") (transform #'identity))
+(defun add-page (name title content &key (parent 0) rendered-content (username "nobody") (transform #'identity) draftp)
"Add a new page to the database"
(funcall transform (create-dao 'blog-pages
:name name
:parent parent
:title title
:content content
+ :rendered-content rendered-content
+ :draftp (as-sql-bool draftp)
:username username
:last-updated-by username)))
@@ -145,12 +178,17 @@
(mapcar #'build-tree dao-list)
entry-table)))
-(defun get-pages (&key (root-id 0) (transform #'identity))
+(defun get-pages (&key (root-id 0) (transform #'identity) 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."
- (let* ((entry-table (build-tree-table (select-dao 'blog-pages) transform)))
+ (let* ((entry-table (build-tree-table
+ (if include-drafts-p
+ (select-dao 'blog-pages)
+ (select-dao 'blog-pages
+ (where (:= :draftp "false"))))
+ transform)))
(values (gethash root-id entry-table) entry-table)))
-(defun update-page (id name title content &key (username "nobody") (transform #'identity))
+(defun update-page (id name title content &key rendered-content (username "nobody") (transform #'identity) draftp)
"Update page by id. Returns the updated page or nil if the id doesn't exist."
(let ((entry (get-raw-page id)))
(if entry
@@ -158,10 +196,22 @@
(progn (setf (page-name entry) name)
(setf (page-title entry) title)
(setf (page-content entry) content)
+ (setf (page-rendered-content entry) rendered-content)
(setf (page-last-updated-by entry) username)
+ (setf (page-draftp entry) (as-sql-bool draftp))
(save-dao entry)
entry)))))
+(defun update-page-rendered-content (id rendered-content &key (username "nobody") (transform #'identity))
+ "Updated just the rendered content for a page by ID. Returns the updated page or NIL if ID doesn't exist."
+ (let ((entry (get-raw-page id)))
+ (if entry
+ (funcall transform
+ (progn (setf (page-rendered-content entry) rendered-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)
diff --git a/src/format.lisp b/src/format.lisp
@@ -10,15 +10,21 @@
"Long format datetime, like:
Monday, February 3rd 2020 at 2:46 PM PST")
-(defun markdown (content &optional collapse-link)
- "Translate CONTENT with 3bmd. If EXPAND is true then render the full post, otherwise cut at the first ---."
- (let* ((md-content (with-output-to-string (os)
- (3bmd:parse-string-and-print-to-stream content os)))
- (rule-pos (search "<hr/>" md-content)))
- (if (and rule-pos collapse-link)
+(defun truncate-and-emit-read-more (rendered-content collapse-link)
+ "Cut RENDERED-CONTENT (HTML as emitted by 3BMD) at the first <hr/> and replace with a Read more... link."
+ (let ((rule-pos (search "<hr/>" rendered-content)))
+ (if rule-pos
(concatenate 'string
- (subseq md-content 0 rule-pos)
+ (subseq rendered-content 0 rule-pos)
(format nil "<a href=\"~a\">Read more...</a>~%" collapse-link))
+ rendered-content)))
+
+(defun markdown (content &optional collapse-link)
+ "Translate CONTENT with 3bmd. If COLLAPSE-LINK is NIL then unconditionally render the full post, otherwise cut at the first ---."
+ (let ((md-content (with-output-to-string (os)
+ (3bmd:parse-string-and-print-to-stream content os))))
+ (if collapse-link
+ (truncate-and-emit-read-more md-content collapse-link)
md-content)))
(defun rfc-822-format (datetime &optional (tz *default-timezone*))
@@ -104,6 +110,9 @@
(def-filter :markdown (content &optional collapse-link)
(markdown content (when collapse-link (djula::resolve-variable-phrase (djula::parse-variable-phrase collapse-link)))))
+(def-filter :read-more (content collapse-link)
+ (truncate-and-emit-read-more content (djula::resolve-variable-phrase (djula::parse-variable-phrase collapse-link))))
+
(def-filter :strip-html (content)
(format nil "~{~A~}"
(mapcar
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -245,6 +245,7 @@
(new-entry (miniblog.data:add-entry
(or title "Untitled")
content
+ :rendered-content (miniblog.format:markdown content)
:username (get-username)))
(year-month (miniblog.content:year-month-of-entry new-entry))
(year (car year-month))
@@ -270,6 +271,7 @@
name
(or title "Untitled")
content
+ :rendered-content (miniblog.format:markdown content)
:parent parent-id
:username (get-username))))
(if (or regen (= (length uri-components) 1))
@@ -329,6 +331,7 @@
(content (nth 1 post)))
(miniblog.data:update-entry
id title content
+ :rendered-content (miniblog.format:markdown content)
:username (get-username))
(let* ((created-at (getf entry :created-at))
(year (timestamp-year created-at))
@@ -347,6 +350,7 @@
(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)
(let* ((pages-tuple (multiple-value-list (miniblog.data:get-pages)))
@@ -452,7 +456,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.data:get-pages start)))
+ (let ((pages (miniblog.data:get-pages :root-id start)))
(traverse pages 0))))
(defun init-tz ()
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -20,34 +20,35 @@
(defpackage :miniblog.db
(:use :cl :mito :sxql)
- (:export blog-entries blog-pages
+ (:export #:blog-entries #:blog-pages
#:entry-username #:entry-last-updated-by #:entry-title #:entry-content
+ #:entry-rendered-content #:entry-draftp
#:page-username #:page-last-updated-by #:page-name #:page-parent
- #:page-title #:page-content
+ #:page-title #:page-content #:page-rendered-content #:page-draftp
#:init #:init-tables #:add-entry #:get-entry
- #:get-entries #:update-entry #:delete-entry
+ #:get-entries #:update-entry #:update-entry-rendered-content #:delete-entry
#:add-page #:get-page
- #:get-pages #:update-page #:delete-page
+ #:get-pages #:update-page #:update-page-rendered-content #: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
+ :entry-content :entry-rendered-content :entry-draftp
:page-username :page-last-updated-by :page-name :page-parent
- :page-title :page-content)
+ :page-title :page-content :page-rendered-content :page-draftp)
(:export #:add-entry #:get-entry #:with-entry-id
- #:get-entries #:update-entry #:delete-entry
+ #:get-entries #:update-entry #:update-entry-rendered-content #:delete-entry
#:add-page #:get-page #:with-page-id
- #:get-pages #:update-page #:delete-page
+ #:get-pages #:update-page #:update-page-rendered-content #:delete-page
#:move-page))
(defpackage :miniblog.content
(:use :cl :local-time :str)
(:import-from :djula :add-template-directory :compile-template*
:render-template*)
- (:export *posts-template* *page-template* *rss-template*
+ (:export #:*posts-template* #:*page-template* #:*rss-template*
#:render-posts #:render-page #:render-rss
#:make-generator #:make-page-generator
#:make-rss-generator #:get-archive-date-list
@@ -60,9 +61,9 @@
(:use :cl :command-line-arguments :local-time)
(:import-from :alexandria :if-let :when-let*)
(:export #:initialize #:entry-point
- *blog-title* *blog-header* *blog-links* *blog-stylesheet*
- *blog-timezone* *db-config* *public-html* *root-uri*
- *generator* *page-generator* *rss-generator*
- *blog-description* *blog-link* *blog-image-url* *blog-language*
- *blog-category* *blog-copyright* *blog-managing-editor*
- *blog-webmaster* *twitter-card*))
+ #:*blog-title* #:*blog-header* #:*blog-links* #:*blog-stylesheet*
+ #:*blog-timezone* #:*db-config* #:*public-html* #:*root-uri*
+ #:*generator* #:*page-generator* #:*rss-generator*
+ #:*blog-description* #:*blog-link* #:*blog-image-url* #:*blog-language*
+ #:*blog-category* #:*blog-copyright* #:*blog-managing-editor*
+ #:*blog-webmaster* #:*twitter-card*))
diff --git a/templates/page.dtl b/templates/page.dtl
@@ -7,13 +7,13 @@
<meta name="twitter:image" content="{{ twitter-card.image }}">
{% endif %}
<meta name="twitter:title" content="{{ page.title }}">
- <meta name="twitter:description" content="{{ page.content|markdown|strip-html|truncatechars:200 }}">
+ <meta name="twitter:description" content="{{ page.rendered-content|strip-html|truncatechars:200 }}">
{% endif %}
{% endblock %}
{% block main %}
- {% if page.content %}
+ {% if page.rendered-content %}
<h2>{{ page.title }}</h2>
- <article>{{ page.content|safe|markdown }}</article>
+ <article>{{ page.rendered-content|safe }}</article>
<p role="note">
<small>
Posted by {{ page.created-by }} on {{ page.created-at-long }}
diff --git a/templates/posts.dtl b/templates/posts.dtl
@@ -8,7 +8,7 @@
{% endif %}
{% if posts %}
<meta name="twitter:title" content="{{ posts.0.title }}">
- <meta name="twitter:description" content="{{ posts.0.content|markdown|strip-html|truncatechars:200 }}">
+ <meta name="twitter:description" content="{{ posts.0.rendered-content|strip-html|truncatechars:200 }}">
{% else %}
<meta name="twitter:title" content="{{ title }}">
{% endif %}
@@ -27,11 +27,11 @@
{% if collapse-posts-p %}
<h2><a href="{{ post.link }}">{{ post.title }}</a></h2>
<article>
- {{ post.content|safe|markdown:post.link }}
+ {{ post.rendered-content|safe|read-more:post.link }}
</article>
{% else %}
<h2>{{ post.title }}</h2>
- <article>{{ post.content|safe|markdown }}</article>
+ <article>{{ post.rendered-content|safe }}</article>
{% endif %}
<p role="note">
<small>
diff --git a/templates/rss.dtl b/templates/rss.dtl
@@ -43,10 +43,10 @@
<item>
<title>{{ post.title }}</title>
<link>{{ link }}#{{ post.id }}</link>
- <description>{{ post.content|markdown|strip-html|truncatechars:200 }}</description>
+ <description>{{ post.rendered-content|strip-html|truncatechars:200 }}</description>
<pubDate>{{ post.created-at-rfc-822 }}</pubDate>
<content:encoded><![CDATA[
- {{ post.content|markdown|safe }}
+ {{ post.rendered-content|safe }}
]]></content:encoded>
</item>
{% endfor %}
