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

Merge pull request #78 from cmstrickland/document-find-class

Browse source 
find-all matching adjusted
This commit is contained in:
Cthulhux 2021-05-26 16:01:47 +02:00 • committed by GitHub
commit bea699ebeb
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 17 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
plugins/incremental.lisp
View file

@ -59,14 +59,11 @@
(:method :around (status path &key) (:method :around (status path &key)
(let ((extension (pathname-type path)) (let ((extension (pathname-type path))
(ctypes (all-subclasses (find-class 'content)))) (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)))))
;; If the updated file's extension doesn't match one of our content types, ;; If the updated file's extension doesn't match one of our content types,
;; we don't need to mess with it at all. Otherwise, since the class is ;; we don't need to mess with it at all. Otherwise, since the class is
;; annoyingly tricky to determine, pass it along. ;; annoyingly tricky to determine, pass it along.
(when-let (ctype (find extension ctypes :test #'class-name-p)) (when-let (ctype (find extension ctypes :test #'class-name-p))
(call-next-method status path :ctype ctype)))))) (call-next-method status path :ctype ctype)))))
(defmethod process-change ((status (eql :deleted)) path &key) (defmethod process-change ((status (eql :deleted)) path &key)
(let ((old (find-content-by-path path))) (let ((old (find-content-by-path path)))

11
src/documents.lisp
View file

@ -68,12 +68,15 @@ use it as the template passing any RENDER-ARGS."
(url (namestring (page-url document)))) (url (namestring (page-url document))))
(write-file (rel-path (staging-dir *config*) url) html))) (write-file (rel-path (staging-dir *config*) url) html)))
(defun find-all (doc-type) (defun find-all (doc-type &optional (matches-p (lambda (x) (typep x doc-type))))
"Return a list of all instances of a given DOC-TYPE." "Return a list of all instances of a given DOC-TYPE."
(loop for val being the hash-values in *site* (loop for val being the hash-values in *site*
when (typep val doc-type) collect val)) when (funcall matches-p val) collect val))
(defun purge-all (doc-type) (defun purge-all (doc-type)
"Remove all instances of DOC-TYPE from memory." "Remove all instances of DOC-TYPE from memory."
(dolist (obj (find-all doc-type)) (flet ((matches-class-name-p (x)
(remhash (page-url obj) *site*))) (class-name-p (symbol-name doc-type)
(class-of x))))
(dolist (obj (find-all doc-type #'matches-class-name-p))
(remhash (page-url obj) *site*))))

5
src/util.lisp
View file

@ -122,3 +122,8 @@ in the git repo since REVISION."
(cl-ppcre:split "\\s+" str))) (cl-ppcre:split "\\s+" str)))
(let ((cmd (format nil "git diff --name-status ~A HEAD" revision))) (let ((cmd (format nil "git diff --name-status ~A HEAD" revision)))
(mapcar #'split-on-whitespace (inferior-shell:run/lines cmd))))) (mapcar #'split-on-whitespace (inferior-shell:run/lines cmd)))))
(defun class-name-p (name class)
"True if the specified string is the name of the class provided"
;; This feels way too clever. I wish I could think of a better option.
(string-equal name (symbol-name (class-name class))))