Further cleanups to no-arg functions from @bigthingist's review.

This commit is contained in:
Brit Butler 2012-08-27 15:03:34 -04:00
parent 7d9f26a15c
commit a7af16e7eb
4 changed files with 30 additions and 34 deletions

View file

@ -21,30 +21,29 @@ If RAW is non-nil, write the content without wrapping it in the base template."
:credits (author *config*)))))
(write-line (if raw html content) out)))))
(defun compile-blog ()
"Compile the blog to a staging directory in /tmp."
(let ((staging (staging *config*)))
; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
(when (probe-file staging)
(delete-directory-and-files staging))
(ensure-directories-exist staging)
(with-current-directory staging
(let ((css-dir (app-path "themes/~a/css" (theme *config*)))
(static-dir (merge-pathnames "static" (repo *config*))))
(dolist (dir (list css-dir static-dir))
(when (probe-file dir)
(run-program "cp" `("-R" ,(namestring dir) ".")))))
(render-posts)
(render-indices)
(render-feed))))
(defun compile-blog (staging)
"Compile the blog to a STAGING directory as specified in .coleslawrc."
; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
(when (probe-file staging)
(cl-fad:delete-directory-and-files staging))
(ensure-directories-exist staging)
(with-current-directory staging
(let ((css-dir (app-path "themes/~a/css" (theme *config*)))
(static-dir (merge-pathnames "static" (repo *config*))))
(dolist (dir (list css-dir static-dir))
(when (probe-file dir)
(run-program "cp" `("-R" ,(namestring dir) ".")))))
(render-posts)
(render-indices)
(render-feed)))
(defun update-symlink (path target)
"Update the symlink at PATH to point to TARGET."
(run-program "ln" (list "-sfn" (namestring target) (namestring path))))
(defgeneric deploy (dir)
(:documentation "Deploy DIR, updating the .prev and .curr symlinks.")
(:method (dir)
(defgeneric deploy (staging)
(:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.")
(:method (staging)
(flet ((deploy-path (path &rest args)
(merge-pathnames (apply 'format nil path args) (deploy *config*))))
(let ((new-build (deploy-path "generated/~a" (get-universal-time)))
@ -52,9 +51,9 @@ If RAW is non-nil, write the content without wrapping it in the base template."
(curr (deploy-path ".curr")))
(ensure-directories-exist new-build)
(with-current-directory coleslaw-conf:*basedir*
(run-program "mv" (mapcar #'namestring (list dir new-build)))
(run-program "mv" (mapcar #'namestring (list staging new-build)))
(when (probe-file prev)
(delete-directory-and-files (read-symlink prev)))
(cl-fad:delete-directory-and-files (read-symlink prev)))
(when (probe-file curr)
(update-symlink prev (read-symlink curr)))
(update-symlink curr new-build))))))
@ -62,6 +61,6 @@ If RAW is non-nil, write the content without wrapping it in the base template."
(defun main ()
"Load the user's config, then compile and deploy the blog."
(load-config)
(compile-theme)
(compile-blog)
(compile-theme (app-path "themes/~a/" (theme *config*)))
(compile-blog (staging *config*))
(deploy (staging *config*)))

View file

@ -1,8 +1,6 @@
(defpackage :coleslaw
(:documentation "Homepage: <a href=\"http://github.com/redline6561/coleslaw\">Github</a>")
(:use :cl :closure-template)
(:import-from :cl-fad #:delete-directory-and-files
#:list-directory)
(:import-from :iolib.os #:with-current-directory
#:run-program)
(:import-from :iolib.pathnames #:file-path-namestring)

View file

@ -16,7 +16,7 @@
"Find the symbol NAME inside the current theme's package."
(find-symbol name (theme-package)))
(defun compile-theme (&key (theme-dir (app-path "themes/~a/" (theme *config*))))
(defun compile-theme (theme-dir)
"Iterate over the files in THEME-DIR, compiling them when they are templates."
(do-files (file theme-dir "tmpl")
(compile-template :common-lisp-backend file)))

View file

@ -14,13 +14,12 @@ If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH."
(to-pathname (iolib.os:read-symlink path)))
(defmacro do-files ((var path &optional extension) &body body)
"For each file under PATH, run BODY. If EXTENSION is provided, only run BODY
"For each file on PATH, run BODY. If EXTENSION is provided, only run BODY
on files that match the given extension."
(alexandria:with-gensyms (ext)
`(mapcar (lambda (,var)
,@(if extension
`((let ((,ext (pathname-type ,var)))
(when (and ,ext (string= ,ext ,extension))
,@body)))
`,body))
(list-directory ,path))))
`(dolist (,var (cl-fad:list-directory ,path))
,@(if extension
`((let ((,ext (pathname-type ,var)))
(when (and ,ext (string= ,ext ,extension))
,@body)))
`,body))))