coleslaw/src/coleslaw.lisp

(in-package :coleslaw)

(defun render-page (path html &optional raw)
  "Populate the base template with the provided HTML and write it out to PATH.
If RAW is non-nil, write the content without wrapping it in the base template."
  (let ((filepath (merge-pathnames path (staging *config*))))
    (ensure-directories-exist filepath)
    (with-open-file (out filepath
                         :direction :output
                         :if-does-not-exist :create)
      (let ((content (funcall (theme-fn "BASE")
                              (list :title (title *config*)
                                    :siteroot (domain *config*)
                                    :navigation (sitenav *config*)
                                    :content html
                                    :head-inject (apply #'concatenate 'string
                                                        (gethash :head *injections*))
                                    :body-inject (apply #'concatenate 'string
                                                        (gethash :body *injections*))
                                    :license (license *config*)
                                    :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))
    (deploy staging)
    (setf (last-published) (last-commit))))

(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)
    (let ((new-build (app-path "generated/~a" (get-universal-time))))
      (ensure-directories-exist new-build)
      (with-current-directory coleslaw-conf:*basedir*
        (run-program "mv" (mapcar #'namestring (list dir new-build)))
        (when (probe-file (app-path ".prev"))
          (delete-directory-and-files (read-symlink (app-path ".prev"))))
        (when (probe-file (app-path ".curr"))
          (update-symlink ".prev" (read-symlink (app-path ".curr"))))
        (update-symlink ".curr" new-build)))))

(defun main ()
  (load-config)
  (compile-theme)
  (loop do (if (blog-update-p)
               (compile-blog)
               (sleep (interval *config*)))))