marcuskammer/coleslaw
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Push sketch slightly further up hill.

Browse source
This commit is contained in:
Brit Butler 2014-05-18 23:59:27 -04:00
parent 7c12a9670b
commit 75c30c5844
2 changed files with 44 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
plugins/incremental.lisp
View file

@ -3,15 +3,25 @@
(defpackage :coleslaw-incremental
(:use :cl)
(:import-from :coleslaw #:get-updated-files
(:import-from :alexandria #:when-let)
(:import-from :coleslaw #:all-subclasses
#:content
#:construct
#:get-updated-files
#:find-content-by-path
#:write-document)
#:write-document
#:rel-path)
(:export #:enable))
(in-package :coleslaw-incremental)
;; FIXME: We currently never update the site for config changes.
;; Examples to consider include changing the theme or domain of the site.
;; Both would require full site recompiles. Consequently, it seems reasonable
;; to expect that incremental plugin users:
;; A) have done a full build of their site
;; B) have a cl-store dump of the database at ~/.coleslaw.db
;; ^ we should provide a script or plugin just for this
;; NOTE: We're gonna be a bit dirty here and monkey patch. The compilation model
;; still isn't an "exposed" part of Coleslaw. After some experimentation maybe
@ -21,7 +31,6 @@
"A list of changed content instances to iterate over and write out to disk.")
(defun coleslaw::load-content ()
;; TODO: What if the file doesn't exist?
(let ((db-file (rel-path (user-homedir-pathname) ".coleslaw.db")))
(setf coleslaw::*site* (cl-store:restore db-file))
(loop for (status path) in (get-updated-files)
@ -33,8 +42,28 @@
((string= "M" status) (process-change :modified path))
((string= "A" status) (process-change :added path))))
(defgeneric process-change (status path)
(:documentation "Updates the database as needed for the STATUS change to PATH."))
(defgeneric process-change (status path &key &allow-other-keys)
(:documentation "Updates the database as needed for the STATUS change to PATH.")
(:method :around (status path &key)
(let ((extension (pathname-type path))
(ctypes (all-subclasses (find-class 'content))))
;; This feels way too clever. I wish I could think of a better option.
(flet ((class-name-p (x class)
(string-equal x (symbol-name (class-name class)))))
(when-let (ctype (find extension ctypes :test #'class-name-p))
(call-next-method status path :ctype ctype))))))
(defmethod process-change ((status (eql :deleted)) path &key)
(let ((obj (find-content-by-path path)))
))
(defmethod process-change ((status (eql :modified)) path &key)
(let ((obj (find-content-by-path path)))
))
(defmethod process-change ((status (eql :added)) path &key ctype)
(let ((obj (construct ctype (read-content path))))
))
(defun coleslaw::compile-blog (staging)
"lulz. Do it live. DO IT ALL LIVE."

17
src/util.lisp
View file

@ -4,16 +4,19 @@
"Create an instance of CLASS-NAME with the given ARGS."
(apply 'make-instance class-name args))
;; Thanks to bknr-web for this bit of code.
(defun all-subclasses (class)
"Return a list of all the subclasses of CLASS."
(let ((subclasses (closer-mop:class-direct-subclasses class)))
(append subclasses (loop for subclass in subclasses
nconc (all-subclasses subclass)))))
(defmacro do-subclasses ((var class) &body body)
"Iterate over the subclasses of CLASS performing BODY with VAR
lexically bound to the current subclass."
(alexandria:with-gensyms (klasses all-subclasses)
`(labels ((,all-subclasses (class)
(let ((subclasses (closer-mop:class-direct-subclasses class)))
(append subclasses (loop for subclass in subclasses
nconc (,all-subclasses subclass))))))
(let ((,klasses (,all-subclasses (find-class ',class))))
(loop for ,var in ,klasses do ,@body)))))
(alexandria:with-gensyms (klasses)
`(let ((,klasses (all-subclasses (find-class ',class))))
(loop for ,var in ,klasses do ,@body))))
(defmacro do-files ((var path &optional extension) &body body)
"For each file under PATH, run BODY. If EXTENSION is provided, only run