Kaynağa Gözat

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

Brit Butler 12 yıl önce
ebeveyn
işleme
a7af16e7eb
4 değiştirilmiş dosya ile 30 ekleme ve 34 silme
  1. 22 23
      src/coleslaw.lisp
  2. 0 2
      src/packages.lisp
  3. 1 1
      src/themes.lisp
  4. 7 8
      src/util.lisp

+ 22 - 23
src/coleslaw.lisp

@@ -21,30 +21,29 @@ If RAW is non-nil, write the content without wrapping it in the base template."
21 21
                                     :credits (author *config*)))))
22 22
         (write-line (if raw html content) out)))))
23 23
 
24
-(defun compile-blog ()
25
-  "Compile the blog to a staging directory in /tmp."
26
-  (let ((staging (staging *config*)))
27
-    ; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
28
-    (when (probe-file staging)
29
-      (delete-directory-and-files staging))
30
-    (ensure-directories-exist staging)
31
-    (with-current-directory staging
32
-      (let ((css-dir (app-path "themes/~a/css" (theme *config*)))
33
-            (static-dir (merge-pathnames "static" (repo *config*))))
34
-        (dolist (dir (list css-dir static-dir))
35
-          (when (probe-file dir)
36
-            (run-program "cp" `("-R" ,(namestring dir) ".")))))
37
-      (render-posts)
38
-      (render-indices)
39
-      (render-feed))))
24
+(defun compile-blog (staging)
25
+  "Compile the blog to a STAGING directory as specified in .coleslawrc."
26
+  ; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
27
+  (when (probe-file staging)
28
+    (cl-fad:delete-directory-and-files staging))
29
+  (ensure-directories-exist staging)
30
+  (with-current-directory staging
31
+    (let ((css-dir (app-path "themes/~a/css" (theme *config*)))
32
+          (static-dir (merge-pathnames "static" (repo *config*))))
33
+      (dolist (dir (list css-dir static-dir))
34
+        (when (probe-file dir)
35
+          (run-program "cp" `("-R" ,(namestring dir) ".")))))
36
+    (render-posts)
37
+    (render-indices)
38
+    (render-feed)))
40 39
 
41 40
 (defun update-symlink (path target)
42 41
   "Update the symlink at PATH to point to TARGET."
43 42
   (run-program "ln" (list "-sfn" (namestring target) (namestring path))))
44 43
 
45
-(defgeneric deploy (dir)
46
-  (:documentation "Deploy DIR, updating the .prev and .curr symlinks.")
47
-  (:method (dir)
44
+(defgeneric deploy (staging)
45
+  (:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.")
46
+  (:method (staging)
48 47
     (flet ((deploy-path (path &rest args)
49 48
              (merge-pathnames (apply 'format nil path args) (deploy *config*))))
50 49
       (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."
52 51
             (curr (deploy-path ".curr")))
53 52
         (ensure-directories-exist new-build)
54 53
         (with-current-directory coleslaw-conf:*basedir*
55
-          (run-program "mv" (mapcar #'namestring (list dir new-build)))
54
+          (run-program "mv" (mapcar #'namestring (list staging new-build)))
56 55
           (when (probe-file prev)
57
-            (delete-directory-and-files (read-symlink prev)))
56
+            (cl-fad:delete-directory-and-files (read-symlink prev)))
58 57
           (when (probe-file curr)
59 58
             (update-symlink prev (read-symlink curr)))
60 59
           (update-symlink curr new-build))))))
@@ -62,6 +61,6 @@ If RAW is non-nil, write the content without wrapping it in the base template."
62 61
 (defun main ()
63 62
   "Load the user's config, then compile and deploy the blog."
64 63
   (load-config)
65
-  (compile-theme)
66
-  (compile-blog)
64
+  (compile-theme (app-path "themes/~a/" (theme *config*)))
65
+  (compile-blog (staging *config*))
67 66
   (deploy (staging *config*)))

+ 0 - 2
src/packages.lisp

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

+ 1 - 1
src/themes.lisp

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

+ 7 - 8
src/util.lisp

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