Sfoglia il codice sorgente

Push sketch slightly further up hill.

Brit Butler 11 anni fa
parent
commit
75c30c5844
2 ha cambiato i file con 44 aggiunte e 12 eliminazioni
  1. 34 5
      plugins/incremental.lisp
  2. 10 7
      src/util.lisp

+ 34 - 5
plugins/incremental.lisp

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

+ 10 - 7
src/util.lisp

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