Add cl-fad for do-files and directory deletion.

This commit is contained in:
Brit Butler 2012-08-21 15:57:01 -04:00
parent ef315397a4
commit 34c05403e9
3 changed files with 13 additions and 12 deletions

View file

@ -1,11 +1,11 @@
(defsystem #:coleslaw
:name "coleslaw-core"
:description "Flexible Lisp Blogware"
:version "0.0.3"
:version "0.4"
:license "BSD"
:author "Brit Butler <redline6561@gmail.com>"
:pathname "src/"
:depends-on (:closure-template :iolib.os :alexandria)
:depends-on (:closure-template :iolib.os :alexandria :cl-fad)
:serial t
:components ((:file "packages")
(:file "config")

View file

@ -17,13 +17,13 @@ If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH."
"For each file under PATH, run BODY. If EXTENSION is provided, only run BODY
on files that match the given extension."
(alexandria:with-gensyms (ext)
`(iolib.os:mapdir (lambda (x)
(let* ((,var (to-pathname x ,path))
,@(when extension `((,ext (pathname-type ,var)))))
,@(if extension
`((when (and ,ext (string= ,ext ,extension))
,@body))
`,body))) ,path)))
`(mapcar (lambda (,var)
,@(if extension
`((let ((,ext (pathname-type ,var)))
(when (and ,ext (string= ,ext ,extension))
,@body)))
`,body))
(list-directory ,path))))
(defun render-page (path html)
"Populate the base template with the provided HTML and write it out to PATH."
@ -49,7 +49,7 @@ on files that match the given extension."
(let ((staging #p"/tmp/coleslaw/"))
; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
(when (probe-file staging)
(delete-files staging :recursive t))
(delete-directory-and-files staging))
(ensure-directories-exist staging)
(with-current-directory staging
(let ((css-dir (app-path "themes/~a/css/" (theme *config*)))
@ -72,7 +72,7 @@ on files that match the given extension."
(let ((new-build (app-path "generated/~a" (get-universal-time))))
(run-program "mv" (list dir (namestring new-build)))
(when (probe-file (app-path ".prev"))
(delete-files (read-symlink (app-path ".prev")) :recursive t))
(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))))

View file

@ -1,7 +1,8 @@
(defpackage :coleslaw
(:use :cl :closure-template)
(:import-from :cl-fad #:delete-directory-and-files
#:list-directory)
(:import-from :iolib.os #:with-current-directory
#:delete-files
#:read-symlink
#:run-program)
(:import-from :iolib.pathnames #:file-path-namestring)