commit bca9c85ce6727fff1e9df269f5099d60d2dcfee8
parent 8445fbdeee63b0bc280e479363799634c61916e0
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Mon, 12 Oct 2020 22:34:20 -0700
Stop plumbing timezone everywhere
Let's not be afraid of dynamic variables. Just bind
LOCAL-TIME:*DEFAULT-TIMEZONE* instead of plumbing tz around everywhere
forever. We also begin baking the formatted dates into the post/page
structs instead of using those weird formatting lambdas.
Diffstat:
7 files changed, 104 insertions(+), 102 deletions(-)
diff --git a/src/content.lisp b/src/content.lisp
@@ -18,7 +18,7 @@
:defaults this-file)))
(defun make-generator (&key title root-uri header links stylesheet)
- (lambda (entries pages &key year month archive-date-list tz enable-rss)
+ (lambda (entries pages &key year month archive-date-list enable-rss)
(let ((*default-pathname-defaults* *templates-dir*))
(execute-emb
"default-template"
@@ -35,11 +35,11 @@
:pages pages
:archive-date-list archive-date-list
:content-formatter #'miniblog.format:markdown
- :short-date-formatter (lambda (datetime) (miniblog.format:short-date-format datetime (or tz *default-timezone*)))
- :long-date-formatter (lambda (datetime) (miniblog.format:long-date-format datetime (or tz *default-timezone*))))))))
+ :short-date-formatter (lambda (datetime) (miniblog.format:short-date-format datetime))
+ :long-date-formatter (lambda (datetime) (miniblog.format:long-date-format datetime)))))))
(defun make-page-generator (&key title root-uri header links stylesheet)
- (lambda (entry path pages &key archive-date-list tz enable-rss)
+ (lambda (entry path pages &key archive-date-list enable-rss)
(let ((*default-pathname-defaults* *templates-dir*))
(execute-emb
"default-page-template"
@@ -55,8 +55,8 @@
:path path
:archive-date-list archive-date-list
:content-formatter #'miniblog.format:markdown
- :short-date-formatter (lambda (datetime) (miniblog.format:short-date-format datetime (or tz *default-timezone*)))
- :long-date-formatter (lambda (datetime) (miniblog.format:long-date-format datetime (or tz *default-timezone*))))))))
+ :short-date-formatter (lambda (datetime) (miniblog.format:short-date-format datetime))
+ :long-date-formatter (lambda (datetime) (miniblog.format:long-date-format datetime)))))))
(defun strip-html-tags (content)
(format nil "~{~A~}"
@@ -69,7 +69,7 @@
(defun make-rss-generator (&key title link description image-url language
copyright managing-editor webmaster category)
(if (and title link description)
- (lambda (entries &key tz)
+ (lambda (entries)
(let ((*default-pathname-defaults* *templates-dir*))
(execute-emb
"rss"
@@ -87,9 +87,9 @@
:build-date (now)
:content-formatter #'miniblog.format:markdown
:content-stripper #'strip-html-tags
- :rfc-822-date-formatter (lambda (datetime) (miniblog.format:rfc-822-format datetime (or tz *default-timezone*)))))))
- (lambda (entries &key tz)
- (declare (ignore entries tz)))))
+ :rfc-822-date-formatter (lambda (datetime) (miniblog.format:rfc-822-format datetime))))))
+ (lambda (entries)
+ (declare (ignore entries)))))
(defun get-page-by-path (path pages)
(labels ((get-page-name (name page-list)
@@ -112,51 +112,49 @@
when (null page) return nil
collect (getf page :name))))
-(defun year-month-of-entry (entry &key tz)
+(defun year-month-of-entry (entry)
(if (not entry)
(error "Entry cannot be nil")
- (let* ((real-tz (or tz *default-timezone*))
- (entry-created-at (getf entry :created-at))
- (entry-year (timestamp-year entry-created-at :timezone real-tz))
- (entry-month (timestamp-month entry-created-at :timezone real-tz)))
+ (let* ((entry-created-at (getf entry :created-at))
+ (entry-year (timestamp-year entry-created-at))
+ (entry-month (timestamp-month entry-created-at)))
(cons entry-year entry-month))))
-(defun year-month-of-latest-entry (entries &key tz)
+(defun year-month-of-latest-entry (entries)
(if (not entries)
(error "List of entries cannot be empty")
- (year-month-of-entry (car entries) :tz tz)))
+ (year-month-of-entry (car entries))))
-(defun monthcdr (entries year month tz)
+(defun monthcdr (entries year month)
(if (not entries)
nil
(let*
- ((year-month (year-month-of-latest-entry entries :tz tz))
+ ((year-month (year-month-of-latest-entry entries))
(entry-year (car year-month))
(entry-month (cdr year-month)))
(cond
((< entry-year year) entries)
((and (= entry-year year) (<= entry-month month)) entries)
- (t (monthcdr (cdr entries) year month tz))))))
+ (t (monthcdr (cdr entries) year month))))))
-(defun collect-entries-for-month (entries year month tz)
+(defun collect-entries-for-month (entries year month)
(if (not entries)
(cons nil entries)
- (let* ((year-month (year-month-of-latest-entry entries :tz tz))
+ (let* ((year-month (year-month-of-latest-entry entries))
(entry-year (car year-month))
(entry-month (cdr year-month)))
(if (or (/= entry-year year) (/= entry-month month))
(cons nil entries)
(let ((collected (collect-entries-for-month
- (cdr entries) year month tz)))
+ (cdr entries) year month)))
(cons (cons (car entries) (car collected)) (cdr collected)))))))
-(defun get-archive-date-list (entries tz)
+(defun get-archive-date-list (entries)
(labels
((get-year-month-pair-for-entry (entry)
- (let* ((real-tz (or tz *default-timezone*))
- (created-at (getf entry :created-at))
- (year (timestamp-year created-at :timezone real-tz))
- (month (timestamp-month created-at :timezone real-tz)))
+ (let* ((created-at (getf entry :created-at))
+ (year (timestamp-year created-at))
+ (month (timestamp-month created-at)))
(cons year month)))
(year-month-pairs-equal-p (a b)
(and (= (car a) (car b)) (= (cdr a) (cdr b)))))
@@ -164,7 +162,7 @@
(mapcar #'get-year-month-pair-for-entry entries)
:test #'year-month-pairs-equal-p)))
-(defun gen-all-pages (pages &key prefix all-pages archive-date-list generator tz enable-rss)
+(defun gen-all-pages (pages &key prefix all-pages archive-date-list generator enable-rss)
"Generate all pages in the tree rooted at PAGES. PREFIX may be supplied if this is a subtree, in which case ALL-PAGES should also be supplied so that the page nav can render correctly."
(labels ((with-paths (parent-path entries)
(mapcar #'(lambda (entry)
@@ -180,7 +178,6 @@
path
(or all-pages pages)
:generator generator
- :tz tz
:archive-date-list archive-date-list
:enable-rss enable-rss))
(next-page-entry (list :page path next-page-content))
@@ -190,10 +187,10 @@
(append queue-rest queue-new))))))
(gen-pages-recur nil (with-paths prefix (getf pages :children)))))
-(defun gen-all (entries pages &key generator page-generator rss-generator tz)
+(defun gen-all (entries pages &key generator page-generator rss-generator)
"Generate a list of all monthly pages and hierarchical pages as well as the index and RSS feed"
(labels
- ((gen-all-years (entries pages archive-date-list generator tz enable-rss)
+ ((gen-all-years (entries pages archive-date-list generator enable-rss)
(let ((rest-entries (copy-list entries))
(content '()))
(loop for year-month in archive-date-list do
@@ -203,62 +200,56 @@
pages
:enable-rss enable-rss
:archive-date-list archive-date-list
- :generator generator
- :tz tz)))
+ :generator generator)))
(setf rest-entries (cdr month-content))
(setf content (cons (car month-content) content))))
content)))
- (let ((archive-date-list (get-archive-date-list entries tz))
+ (let ((archive-date-list (get-archive-date-list entries))
(rss-content (gen-rss-feed entries
- :generator rss-generator
- :tz tz)))
+ :generator rss-generator)))
(append (list
(list :rss nil rss-content)
(list :index nil (gen-index entries pages
:enable-rss rss-content
:archive-date-list archive-date-list
- :generator generator
- :tz tz)))
+ :generator generator)))
(gen-all-pages pages
:archive-date-list archive-date-list
:generator page-generator
- :tz tz
:enable-rss rss-content)
(gen-all-years entries pages
- archive-date-list generator tz rss-content)))))
+ archive-date-list generator rss-content)))))
(defun top-ten (entries)
(if (>= (length entries) 10)
(subseq entries 0 10)
entries))
-(defun gen-rss-feed (entries &key generator tz)
+(defun gen-rss-feed (entries &key generator)
"Generate the RSS feed content with the same posts as the index page"
(let ((index-entries (top-ten entries)))
(funcall (or generator (make-rss-generator))
- index-entries
- :tz tz)))
+ index-entries)))
-(defun gen-index (entries pages &key generator tz archive-date-list enable-rss)
+(defun gen-index (entries pages &key generator archive-date-list enable-rss)
"Generate the index (front page) with the latest ten posts"
(if (not entries)
- (funcall (or generator (make-generator)) nil :tz tz)
+ (funcall (or generator (make-generator)) nil)
(let ((archive-date-list (or archive-date-list
- (get-archive-date-list entries tz)))
+ (get-archive-date-list entries)))
(index-entries (top-ten entries)))
(funcall (or generator (make-generator))
index-entries pages
:enable-rss enable-rss
- :archive-date-list archive-date-list
- :tz tz))))
+ :archive-date-list archive-date-list))))
-(defun gen-month (entries year month pages &key generator tz archive-date-list enable-rss)
+(defun gen-month (entries year month pages &key generator archive-date-list enable-rss)
"Generate a page with all posts for the given year and month"
(let ((archive-date-list (or archive-date-list
- (get-archive-date-list entries tz))))
- (let* ((entries-at-month (monthcdr entries year month tz))
+ (get-archive-date-list entries))))
+ (let* ((entries-at-month (monthcdr entries year month))
(collected (collect-entries-for-month
- entries-at-month year month tz))
+ entries-at-month year month))
(month-entries (car collected))
(rest-entries (cdr collected)))
(cons
@@ -269,23 +260,20 @@
:year year
:month month
:enable-rss enable-rss
- :archive-date-list archive-date-list
- :tz tz))
+ :archive-date-list archive-date-list))
nil)
rest-entries))))
-(defun gen-post (entry pages &key generator tz archive-date-list enable-rss)
+(defun gen-post (entry pages &key generator archive-date-list enable-rss)
"Generate a single post page"
(funcall (or generator (make-generator))
(list entry) pages
:enable-rss enable-rss
- :archive-date-list archive-date-list
- :tz tz))
+ :archive-date-list archive-date-list))
-(defun gen-page (entry path pages &key generator tz archive-date-list enable-rss)
+(defun gen-page (entry path pages &key generator archive-date-list enable-rss)
"Generate a single page"
(funcall (or generator (make-page-generator))
entry path pages
:enable-rss enable-rss
- :archive-date-list archive-date-list
- :tz tz))
+ :archive-date-list archive-date-list))
diff --git a/src/data.lisp b/src/data.lisp
@@ -3,10 +3,12 @@
(defun format-dates (content)
(let ((created-at (getf content :created-at))
(last-updated-at (getf content :last-updated-at)))
- (setf (getf content :created-at-short) created-at)
- (setf (getf content :created-at-long) created-at)
- (setf (getf content :last-updated-at-short) last-updated-at)
- (setf (getf content :last-updated-at-long) last-updated-at)
+ (setf (getf content :created-at-rfc-822) (miniblog.format:rfc-822-format created-at))
+ (setf (getf content :created-at-short) (miniblog.format:short-date-format created-at))
+ (setf (getf content :created-at-long) (miniblog.format:long-date-format created-at))
+ (setf (getf content :last-updated-at-rfc-822) (miniblog.format:rfc-822-format last-updated-at))
+ (setf (getf content :last-updated-at-short) (miniblog.format:short-date-format last-updated-at))
+ (setf (getf content :last-updated-at-long) (miniblog.format:long-date-format last-updated-at))
content))
(defgeneric xform (entry)
diff --git a/src/format.lisp b/src/format.lisp
@@ -14,19 +14,19 @@
"Translate CONTENT with CL-MARKDOWN"
(nth 1 (multiple-value-list (cl-markdown:markdown content :stream nil))))
-(defun rfc-822-format (datetime tz)
+(defun rfc-822-format (datetime &optional (tz *default-timezone*))
"RFC 822/1123 date formatter for RSS items"
(format-timestring nil datetime
:format +rfc-1123-format+
:timezone tz))
-(defun short-date-format (datetime tz)
+(defun short-date-format (datetime &optional (tz *default-timezone*))
"Short-datetime formatter (see +short-date-format+)"
(format-timestring nil datetime
:format +short-date-format+
:timezone tz))
-(defun long-date-format (datetime tz)
+(defun long-date-format (datetime &optional (tz *default-timezone*))
"Long-datetime formatter (see +long-date-format+)"
(format-timestring nil datetime
:format +long-date-format+
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -162,35 +162,29 @@
(defun regenerate-index-and-given-month (entries year month)
(let ((rss-content (miniblog.content:gen-rss-feed entries
- :generator *rss-generator*
- :tz *blog-timezone*))
+ :generator *rss-generator*))
(pages (miniblog.data:get-pages)))
(regenerate-file (list :rss nil rss-content))
(regenerate-file (list :index nil
(miniblog.content:gen-index entries pages
:enable-rss rss-content
- :generator *generator*
- :tz *blog-timezone*)))
+ :generator *generator*)))
(regenerate-file (car (miniblog.content:gen-month entries year month pages
:enable-rss rss-content
- :generator *generator*
- :tz *blog-timezone*)))))
+ :generator *generator*)))))
(defun regenerate-page-and-parent-and-children (parent-path page-id pages)
(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*))
+ (archive-date-list (miniblog.content:get-archive-date-list entries))
(rss-content (miniblog.content:gen-rss-feed entries
- :generator *rss-generator*
- :tz *blog-timezone*)))
+ :generator *rss-generator*)))
(regenerate-file (list :page parent-path
(miniblog.content:gen-page subtree-root
parent-path
pages
:enable-rss rss-content
:generator *page-generator*
- :tz *blog-timezone*
:archive-date-list archive-date-list)))
(loop for page in (getf subtree-root :children)
do (let ((path (append parent-path (list (getf page :name)))))
@@ -200,7 +194,6 @@
page path pages
:enable-rss rss-content
:generator *page-generator*
- :tz *blog-timezone*
:archive-date-list archive-date-list)))))
(let ((this-page (find-if #'(lambda (entry) (= page-id (getf entry :id))) (getf subtree-root :children))))
(mapcar #'regenerate-file (miniblog.content:gen-all-pages this-page
@@ -208,7 +201,6 @@
:all-pages pages
:enable-rss rss-content
:generator *page-generator*
- :tz *blog-timezone*
:archive-date-list archive-date-list)))))
(defun regenerate-all ()
@@ -216,8 +208,7 @@
(miniblog.data:get-pages)
:generator *generator*
:page-generator *page-generator*
- :rss-generator *rss-generator*
- :tz *blog-timezone*)))
+ :rss-generator *rss-generator*)))
(mapcar #'regenerate-file all)))
(defun entries-in-month (year month)
@@ -242,8 +233,7 @@
(or title "Untitled")
content
:username (get-username)))
- (year-month (miniblog.content:year-month-of-entry
- new-entry :tz *blog-timezone*))
+ (year-month (miniblog.content:year-month-of-entry new-entry))
(year (car year-month))
(month (cdr year-month)))
(if (or regen (new-month-p year month))
@@ -279,7 +269,7 @@
(format t "Invalid page name ~a~%" uri)))
(defun date-format (datetime)
- (miniblog.format:long-date-format datetime *blog-timezone*))
+ (miniblog.format:long-date-format datetime))
(defgeneric get-entry (entry-type id)
(:documentation "Get an entry of type ENTRY-TYPE with id ID"))
@@ -328,10 +318,8 @@
id title content
:username (get-username))
(let* ((created-at (getf entry :created-at))
- (year (timestamp-year created-at
- :timezone *blog-timezone*))
- (month (timestamp-month created-at
- :timezone *blog-timezone*)))
+ (year (timestamp-year created-at))
+ (month (timestamp-month created-at)))
(if (not regen)
(regenerate-index-and-given-month (miniblog.data:get-entries) year month)
(regenerate-all))))
@@ -371,10 +359,8 @@
(format t "Deleting post ID ~d...~%" id)
(miniblog.data:delete-entry id)
(let* ((created-at (getf entry :created-at))
- (year (timestamp-year created-at
- :timezone *blog-timezone*))
- (month (timestamp-month created-at
- :timezone *blog-timezone*)))
+ (year (timestamp-year created-at))
+ (month (timestamp-month created-at)))
(flush-monthly-path year month)
(if (or regen (removed-month-p year month))
(regenerate-all)
@@ -490,7 +476,8 @@
(declare (ignore help))
(initialize)
(apply #'miniblog.db:init *db-config*)
- (let ((entry-type (if page :page :post)))
+ (let ((*default-timezone* *blog-timezone*)
+ (entry-type (if page :page :post)))
(cond (add (add-entry entry-type uri regen-all))
(get (get-entry entry-type get))
(edit (edit-entry entry-type edit regen-all))
diff --git a/tst/data.lisp b/tst/data.lisp
@@ -30,7 +30,19 @@
(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))))))))
+ (getf fetched-entry :last-updated-at))))
+ (is (and (string= (getf new-entry :created-at-short)
+ (getf new-entry :last-updated-at-short))))
+ (is (and (string= (getf new-entry :created-at-short)
+ (miniblog.format:short-date-format (getf new-entry :created-at)))))
+ (is (and (string= (getf new-entry :created-at-long)
+ (getf new-entry :last-updated-at-long))))
+ (is (and (string= (getf new-entry :created-at-long)
+ (miniblog.format:long-date-format (getf new-entry :created-at)))))
+ (is (and (string= (getf new-entry :created-at-rfc-822)
+ (getf new-entry :last-updated-at-rfc-822))))
+ (is (and (string= (getf new-entry :created-at-rfc-822)
+ (miniblog.format:rfc-822-format (getf new-entry :created-at)))))))))
(test modify-entry
"Update an entry, verify update fields"
@@ -92,7 +104,19 @@
(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))))))))
+ (getf fetched-page :last-updated-at))))
+ (is (and (string= (getf new-page :created-at-short)
+ (getf new-page :last-updated-at-short))))
+ (is (and (string= (getf new-page :created-at-short)
+ (miniblog.format:short-date-format (getf new-page :created-at)))))
+ (is (and (string= (getf new-page :created-at-long)
+ (getf new-page :last-updated-at-long))))
+ (is (and (string= (getf new-page :created-at-long)
+ (miniblog.format:long-date-format (getf new-page :created-at)))))
+ (is (and (string= (getf new-page :created-at-rfc-822)
+ (getf new-page :last-updated-at-rfc-822))))
+ (is (and (string= (getf new-page :created-at-rfc-822)
+ (miniblog.format:rfc-822-format (getf new-page :created-at)))))))))
(test modify-page
"Update a page, verify update fields"
diff --git a/tst/format.lisp b/tst/format.lisp
@@ -4,10 +4,11 @@
(test test-date-formatters
"Validate that date formatters return expected results"
- (let ((ts (encode-timestamp 0 0 0 12 20 4 2020 :timezone +utc-zone+)))
- (is (string= "Mon, 20 Apr 2020 12:00:00 +0000" (miniblog.format:rfc-822-format ts +utc-zone+)))
- (is (string= "2020-04-20" (miniblog.format:short-date-format ts +utc-zone+)))
- (is (string= "Monday, April 20th 2020 at 12:00 pm UTC" (miniblog.format:long-date-format ts +utc-zone+)))))
+ (let* ((*default-timezone* +utc-zone+)
+ (ts (encode-timestamp 0 0 0 12 20 4 2020)))
+ (is (string= "Mon, 20 Apr 2020 12:00:00 +0000" (miniblog.format:rfc-822-format ts)))
+ (is (string= "2020-04-20" (miniblog.format:short-date-format ts)))
+ (is (string= "Monday, April 20th 2020 at 12:00 pm UTC" (miniblog.format:long-date-format ts)))))
(test test-markdown-formatter
"Simple validation that the Markdown formatter works"
diff --git a/tst/packages.lisp b/tst/packages.lisp
@@ -3,7 +3,7 @@
(defpackage :miniblog/tests
(:use :cl :fiveam)
(:import-from :local-time :encode-timestamp :timestamp= :timestamp-difference
- :+utc-zone+)
+ :+utc-zone+ :*default-timezone*)
(:import-from :html5-parser :parse-html5-fragment :node-first-child :node-name
:node-value)
(:export #:run-miniblog-tests))
