98 lines
3.8 KiB
Common Lisp
98 lines
3.8 KiB
Common Lisp
(in-package :coleslaw)
|
|
|
|
(defgeneric render (object &key &allow-other-keys)
|
|
(:documentation "Render the given OBJECT to HTML."))
|
|
|
|
(defgeneric render-content (text format)
|
|
(:documentation "Compile TEXT from the given FORMAT to HTML for display.")
|
|
(:method (text (format (eql :html)))
|
|
text)
|
|
(:method (text (format (eql :md)))
|
|
(let ((3bmd-code-blocks:*code-blocks* t))
|
|
(with-output-to-string (str)
|
|
(3bmd:parse-string-and-print-to-stream text str)))))
|
|
|
|
(defgeneric page-url (object)
|
|
(:documentation "The url to the object, without the domain."))
|
|
|
|
(defmethod page-url :around ((object t))
|
|
(let ((result (call-next-method))
|
|
(extension (if (string= (page-ext *config*) "/")
|
|
"html"
|
|
(page-ext *config*))))
|
|
(if (pathname-type result)
|
|
result
|
|
(make-pathname :type extension :defaults result))))
|
|
|
|
(defun page-path (object)
|
|
"The path to store OBJECT at once rendered."
|
|
(rel-path (staging-dir *config*) (namestring (page-url object))))
|
|
|
|
(defun render-page (content &optional theme-fn &rest render-args)
|
|
"Render the given CONTENT to disk using THEME-FN if supplied.
|
|
Additional args to render CONTENT can be passed via RENDER-ARGS."
|
|
(funcall (or theme-fn (theme-fn 'base))
|
|
(list :config *config*
|
|
:content content
|
|
:raw (apply 'render content render-args)
|
|
:pubdate (make-pubdate)
|
|
:injections (find-injections content))))
|
|
|
|
(defun write-page (filepath page)
|
|
"Write the given PAGE to FILEPATH."
|
|
(ensure-directories-exist filepath)
|
|
(with-open-file (out filepath
|
|
:direction :output
|
|
:if-exists :supersede
|
|
:if-does-not-exist :create)
|
|
(write-line page out)))
|
|
|
|
(defun compile-blog (staging)
|
|
"Compile the blog to a STAGING directory as specified in .coleslawrc."
|
|
(ensure-directories-exist staging)
|
|
(with-current-directory staging
|
|
(dolist (dir (list (app-path "themes/~a/css" (theme *config*))
|
|
(app-path "themes/~a/img" (theme *config*))
|
|
(app-path "themes/~a/js" (theme *config*))
|
|
(merge-pathnames "static" (repo *config*))))
|
|
(when (probe-file dir)
|
|
(run-program "rsync --delete -raz ~a ." dir)))
|
|
(do-ctypes (publish (make-keyword ctype)))
|
|
(render-indices)
|
|
(update-symlink "index.html" "1.html")
|
|
(render-feeds (feeds *config*))))
|
|
|
|
(defgeneric deploy (staging)
|
|
(:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.")
|
|
(:method (staging)
|
|
(let* ((dest (deploy-dir *config*))
|
|
(new-build (rel-path dest "generated/~a" (get-universal-time)))
|
|
(prev (rel-path dest ".prev"))
|
|
(curr (rel-path dest ".curr")))
|
|
(ensure-directories-exist new-build)
|
|
(run-program "mv ~a ~a" staging new-build)
|
|
(when (and (probe-file prev) (truename prev))
|
|
(run-program "rm -r ~a" (truename prev)))
|
|
(when (probe-file curr)
|
|
(update-symlink prev (truename curr)))
|
|
(update-symlink curr new-build))))
|
|
|
|
(defun main (&optional config-key)
|
|
"Load the user's config file, then compile and deploy the blog."
|
|
(load-config config-key)
|
|
(load-content)
|
|
(compile-theme (theme *config*))
|
|
(let ((blog (staging-dir *config*)))
|
|
(compile-blog blog)
|
|
(deploy blog)))
|
|
|
|
(defun preview (path &optional (content-type 'post))
|
|
"Render the content at PATH under user's configured repo and save it to
|
|
~/tmp.html. Load the user's config and theme if necessary."
|
|
(let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
|
|
(unless *config*
|
|
(load-config (namestring current-working-directory))
|
|
(compile-theme (theme *config*)))
|
|
(let* ((file (rel-path (repo *config*) path))
|
|
(content (construct content-type (read-content file))))
|
|
(write-page "tmp.html" (render-page content)))))
|