commit b4f6e20ff3862358a8e106920422b3396b3a8da7
parent 83660baa6068c8bae988a2615d47f43458508c45
Author: Decay <decaydjk@tilde.town>
Date: Fri, 7 Feb 2020 21:55:47 +0000
Basic blog functionality
Migrating to cl-emb from eco, support for generating basic blog and
archives
Diffstat:
7 files changed, 291 insertions(+), 55 deletions(-)
diff --git a/miniblog.asd b/miniblog.asd
@@ -5,19 +5,19 @@
:depends-on ("uiop"
"cl-fad"
"cl-markdown"
- "eco"
+ "cl-emb"
"dbd-sqlite3"
"sxql"
"mito"
"local-time"
"str"
"command-line-arguments")
- :defsystem-depends-on (:eco)
:pathname "src/"
:entry-point "miniblog:entry-point"
:components ((:file "packages")
(:file "format")
(:file "edit")
(:file "db")
- (:eco-template "template")
- (:file "miniblog")))
+ (:file "content")
+ (:file "miniblog")
+ (:static-file "template.lhtml")))
diff --git a/src/content.lisp b/src/content.lisp
@@ -0,0 +1,124 @@
+(in-package :miniblog.content)
+
+(defun make-generator (&optional title)
+ (lambda (entries &key year month tz)
+ (execute-emb
+ "default-template"
+ :env (list
+ :title title
+ :posts entries
+ :content-formatter (miniblog.format:make-content-formatter)
+ :short-date-formatter (miniblog.format:make-short-date-formatter (or tz *default-timezone*))
+ :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*))))))
+
+(defun init-generator ()
+ (let ((this-file #.(or *compile-file-truename* *load-truename*)))
+ (register-emb "default-template"
+ (make-pathname :name "template" :type "lhtml"
+ :directory (pathname-directory this-file)
+ :defaults this-file))))
+
+(defun year-month-of-entry (entry &key tz)
+ (if (not entry)
+ (error "Entry cannot be nil")
+ (let* ((real-tz (or tz *default-timezone*))
+ (entry-created-at (nth 1 entry))
+ (entry-year (timestamp-year entry-created-at :timezone real-tz))
+ (entry-month (timestamp-month entry-created-at :timezone real-tz)))
+ (cons entry-year entry-month))))
+
+(defun year-month-of-latest-entry (entries &key tz)
+ (if (not entries)
+ (error "List of entries cannot be empty")
+ (year-month-of-entry (car entries) :tz tz)))
+
+(defun monthcdr (entries year month tz)
+ (if (not entries)
+ nil
+ (let*
+ ((year-month (year-month-of-latest-entry entries :tz tz))
+ (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))))))
+
+(defun collect-entries-for-month (entries year month tz)
+ (if (not entries)
+ (cons nil entries)
+ (let* ((year-month (year-month-of-latest-entry entries :tz tz))
+ (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)))
+ (cons (cons (car entries) (car collected)) (cdr collected)))))))
+
+(defun gen-all (entries &key generator tz)
+ (labels
+ ((gen-all-years (entries next-year generator tz)
+ (let ((year (gen-year entries next-year :generator generator :tz tz)))
+ (if (cdr year)
+ (append
+ (car year)
+ (gen-all-years
+ (cdr year)
+ (car (year-month-of-latest-entry (cdr year) :tz tz))
+ generator tz))
+ (car year)))))
+ (cons
+ (list :index :index (gen-index entries :generator generator :tz tz))
+ (gen-all-years
+ entries (car (year-month-of-latest-entry entries :tz tz))
+ generator tz))))
+
+(defun gen-index (entries &key generator tz)
+ (if (not entries)
+ (funcall (or generator (make-generator)) nil :tz tz)
+ (let* ((year-month (year-month-of-latest-entry entries :tz tz))
+ (entry-year (car year-month))
+ (entry-month (cdr year-month))
+ (latest-month-entries (collect-entries-for-month entries entry-year entry-month tz)))
+ (funcall (or generator (make-generator))
+ (car latest-month-entries)
+ :tz tz))))
+
+(defun gen-year (entries year &key generator tz)
+ (labels
+ ((gen-month-and-earlier (entries year month tz)
+ (let ((this-month (gen-month entries year month
+ :generator generator
+ :tz tz)))
+ (if (> month 1)
+ (let ((earlier (gen-month-and-earlier
+ (cdr this-month) year (- month 1) tz)))
+ (cons
+ (if (car this-month)
+ (cons (car this-month) (car earlier))
+ (car earlier))
+ (cdr earlier)))
+ (cons
+ (if (car this-month)
+ (cons (car this-month) nil)
+ nil)
+ (cdr this-month))))))
+ (gen-month-and-earlier entries year 12 tz)))
+
+(defun gen-month (entries year month &key generator tz)
+ (let* ((entries-at-month (monthcdr entries year month tz))
+ (collected (collect-entries-for-month
+ entries-at-month year month tz))
+ (month-entries (car collected))
+ (rest-entries (cdr collected)))
+ (cons
+ (if month-entries
+ (list year month
+ (funcall (or generator (make-generator))
+ month-entries
+ :year year
+ :month month
+ :tz tz))
+ nil)
+ rest-entries)))
diff --git a/src/db.lisp b/src/db.lisp
@@ -102,3 +102,9 @@
(save-dao entry)
entry))
(error "Post ID ~d not found!" id))))
+
+(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))))
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -1,9 +1,14 @@
(in-package :miniblog)
+(defvar *blog-timezone* *default-timezone*)
+(defvar *public-html* (make-pathname :directory '(:relative "public_html")))
+(defvar *generator*)
+
(defparameter +command-line-spec+
'((("add" #\a) :type boolean :optional t :documentation "Add new post")
(("edit" #\e) :type integer :optional t :documentation "Edit a post by ID")
(("get" #\g) :type integer :optional t :documentation "Get a post by ID")
+ (("delete" #\d) :type integer :optional t :documentation "Delete a post by ID")
(("list" #\l) :type boolean :optional t :documentation "List posts")
(("start" #\s) :type integer :optional t
:documentation "When listing posts, first post to list (default 0)")
@@ -26,20 +31,81 @@
(defun get-username ()
(uiop:getenv "USER"))
+(defun make-generator (&optional title)
+ (miniblog.content:init-generator)
+ (setf *generator* (miniblog.content:make-generator title)))
+
+(defun get-index-file-for-path (path)
+ (merge-pathnames
+ (make-pathname :name "index" :type "html")
+ path))
+
+(defun get-index-path ()
+ (merge-pathnames *public-html* (user-homedir-pathname)))
+
+(defun get-monthly-path (year month)
+ (merge-pathnames
+ (make-pathname :directory
+ (list :relative (write-to-string year)
+ (format nil "~2,'0d" month)))
+ (get-index-path)))
+
+(defun regenerate-file (entry)
+ (let* ((year (nth 0 entry))
+ (month (nth 1 entry))
+ (content (nth 2 entry))
+ (path (if (eql year :index)
+ (get-index-path)
+ (get-monthly-path year month)))
+ (description (if (eql year :index)
+ "index"
+ (format nil "archive for ~d/~2,'0d" year month))))
+ (format t "Regenerating ~a...~%" description)
+ (ensure-directories-exist path)
+ (with-open-file (output (get-index-file-for-path path)
+ :direction :output :if-exists :supersede)
+ (princ content output)
+ (fresh-line output))))
+
+(defun regenerate-index-and-given-month (entries year month)
+ (regenerate-file (list :index :index
+ (miniblog.content:gen-index entries
+ :generator *generator*
+ :tz *blog-timezone*)))
+ (regenerate-file (list year month
+ (miniblog.content:gen-month entries year month
+ :generator *generator*
+ :tz *blog-timezone*))))
+
+(defun regenerate-all (entries)
+ (let ((all (miniblog.content:gen-all entries
+ :generator *generator*
+ :tz *blog-timezone*)))
+ (format t "~a~%" all)
+ (mapcar #'regenerate-file all)))
+
(defun add-new (regen)
(let ((text (miniblog.edit:edit-text)))
(if text
(let* ((post (miniblog.edit:get-title-and-content text))
(title (nth 0 post))
- (content (nth 1 post)))
- (miniblog.db:add-entry
- (or title "Untitled")
- content
- :username (get-username)))
+ (content (nth 1 post))
+ (new-entry (miniblog.db:add-entry
+ (or title "Untitled")
+ content
+ :username (get-username)))
+ (year-month (miniblog.content:year-month-of-entry
+ new-entry :tz *blog-timezone*))
+ (year (car year-month))
+ (month (cdr year-month))
+ (entries (miniblog.db:get-entries)))
+ (if (not regen)
+ (regenerate-index-and-given-month entries year month)
+ (regenerate-all entries)))
(format t "Abandoning post...~%"))))
(defun date-format (datetime)
- (funcall (miniblog.format:make-long-date-formatter *pst*) datetime))
+ (funcall (miniblog.format:make-long-date-formatter *blog-timezone*) datetime))
(defun get-post (id)
(miniblog.db:with-entry-id entry id
@@ -71,6 +137,10 @@
:username (get-username)))
(format t "No change, abandoning...~%")))))
+(defun delete-post (id)
+ (format t "Deleting post ID ~d...~%" id)
+ (miniblog.db:delete-entry id))
+
(defun list-posts (start n)
(let* ((entries (miniblog.db:get-entries))
(first (or start 0))
@@ -82,18 +152,21 @@
(defun init-tz ()
(reread-timezone-repository)
- (defvar *pst* (find-timezone-by-location-name "US/Pacific")))
+ (setf *blog-timezone* (find-timezone-by-location-name "US/Pacific")))
(defun get-db-filename ()
(namestring (merge-pathnames
(user-homedir-pathname)
(make-pathname :name ".miniblog" :type "db"))))
-(defun miniblog (&key add get edit list start n regen-all help)
+(defun miniblog (&key add get edit delete list start n regen-all help)
(init-tz)
+ (make-generator)
(miniblog.db:init :sqlite3 :database-name (get-db-filename))
(cond (add (add-new regen-all))
(get (get-post get))
(edit (edit-post edit regen-all))
+ (delete (delete-post delete))
(list (list-posts start n))
+ (regen-all (regenerate-all (miniblog.db:get-entries)))
(t (show-option-help +command-line-spec+))))
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -13,7 +13,13 @@
(defpackage :miniblog.db
(:use :cl :mito :sxql)
(:export #:init #:add-entry #:get-entry #:with-entry-id
- #:get-entries #:update-entry))
+ #:get-entries #:update-entry #:delete-entry))
+
+(defpackage :miniblog.content
+ (:use :cl :local-time :cl-emb)
+ (:export #:make-generator #:init-generator
+ #:year-month-of-entry #:year-month-of-latest-entry
+ #:gen-all #:gen-index #:gen-year #:gen-month))
(defpackage :miniblog
(:use :cl :command-line-arguments :local-time)
diff --git a/src/template.eco b/src/template.eco
@@ -1,42 +0,0 @@
-<% deftemplate index (posts content-formatter short-date-formatter long-date-formatter &key title year month start-entry max-entries) (:escape-html nil) %>
- <!DOCTYPE html>
- <html>
- <head>
- <title><%= (or title "Miniblog") %></title>
- </head>
- <body>
- <!-- <%= year %><%= month %><%= start-entry %><%= max-entries %> -->
- <% if posts %>
- <% let ((short-date)) %>
- <% loop for (id created-at updated-at title content username last-updated-by) in posts do %>
- <% let ((curr-short-date (funcall short-date-formatter created-at))) %>
- <% if (string/= short-date curr-short-date) %>
- <% setf short-date curr-short-date %><% end %>
- <h1><%= short-date %></h1>
- <% else %>
- <% end %>
- <% end %>
- <h2><%= title %></h2>
- <article>
- <%= (funcall content-formatter content) %>
- </article>
- <p>
- <small>
- Posted by <%= username %> on
- <%= (funcall long-date-formatter created-at) %>
- <% if (local-time:timestamp/= created-at updated-at) %>
- <br>
- Last updated by <%= last-updated-by %> on
- <%= (funcall long-date-formatter updated-at) %>
- <% else %>
- <% end %>
- </small>
- </p>
- <% end %>
- <% end %>
- <% else %>
- No posts found.
- <% end %>
- </body>
- </html>
-<% end %>
diff --git a/src/template.lhtml b/src/template.lhtml
@@ -0,0 +1,69 @@
+<!DOCTYPE html>
+<html>
+ <head>
+ <title><%= (or (getf env :title) "Miniblog") %></title>
+ </head>
+ <body>
+ <header>
+ </header>
+ <% @if posts %>
+ <% (let ((short-date)) %>
+ <% (loop for (id created-at updated-at title content username last-updated-by) in (getf env :posts) do %>
+ <% (let ((curr-short-date (funcall (getf env :short-date-formatter) created-at))) %>
+ <% (if (string/= short-date curr-short-date)
+ (progn
+ (setf short-date curr-short-date)
+ (format t "<h1>~A</h1>~%" short-date)))) %>
+ <h2><%= title %></h2>
+ <article>
+ <%= (funcall (getf env :content-formatter) content) %>
+ </article>
+ <p>
+ <small>
+ Posted by <%= username %> on
+ <%= (funcall (getf env :long-date-formatter) created-at) %>
+ <% (if (local-time:timestamp/= created-at updated-at)
+ (format t "<br>~%Last updated by ~A on ~A~%"
+ last-updated-by
+ (funcall (getf env :long-date-formatter) updated-at))) %>
+ </small>
+ </p>
+ <% ) %>
+ <% ) %>
+ <% @else %>
+ No posts found.
+ <% @endif %>
+ <nav>
+ <% @if archive-date-list %>
+ <% (let ((arc (copy-list (getf env :archive-date-list)))) %>
+ <% (loop while arc do %>
+ <div class="cal-title"><%= (car (car arc)) %></div>
+ <%
+ (let ((month-entries '())
+ (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
+ (loop for cal-month from 12 to 1 do
+ (if (= cal-month (cdr (car arc)))
+ (progn
+ (push (format nil "~d/~2,'0d/index.html" (car (car arc)) (cdr (car arc))) month-entries)
+ (pop arc))
+ (push nil month-entries)))
+ (loop for row from 0 to 2 do %>
+ <div class="cal-row">
+ <% (loop for cal-month from (* row 4) to (+ (* row 4) 3) do %>
+ <span class="cal-cell">
+ <%
+ (if (nth cal-month month-entries)
+ (format t "<a href=\"~a\">~a</a>" (nth cal-month month-entries) (nth cal-month month-names))
+ (format t "~A" (nth cal-month month-names)))
+ %>
+ </span>
+ <% ) %>
+ </div>
+ <% ) %>
+ <% ) %>
+ <% ) %>
+ <% ) %>
+ <% @endif %>
+ </nav>
+ </body>
+</html>
