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

First pass at support for multiple content-types. WARNING: Indices and feeds are broken.

Browse source
This commit is contained in:
Brit Butler 2013-01-01 17:31:33 -05:00
parent 497935af91
commit 6d47244eac
5 changed files with 109 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
coleslaw.asd
View file

@ -12,12 +12,14 @@
:local-time
:inferior-shell
:cl-fad
:cl-ppcre)
:cl-ppcre
:closer-mop)
:serial t
:components ((:file "packages")
(:file "util")
(:file "config")
(:file "themes")
(:file "content")
(:file "posts")
(:file "indices")
(:file "feeds")

4
src/coleslaw.lisp
View file

@ -49,7 +49,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
(merge-pathnames "static" (repo *config*))))
(when (probe-file dir)
(run-program "cp -R ~a ." dir)))
(render-posts)
(do-ctypes (publish (class-name ctype)))
(render-indices)
(render-feeds (feeds *config*))))
@ -76,7 +76,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
"Load the user's config section corresponding to CONFIG-KEY, then
compile and deploy the blog."
(load-config config-key)
(load-posts)
(load-content)
(compile-theme (theme *config*))
(compile-blog (staging *config*))
(deploy (staging *config*)))

81
src/content.lisp Normal file
View file

@ -0,0 +1,81 @@
(in-package :coleslaw)
(defparameter *content* (make-hash-table :test #'equal)
"A hash table to store all the site content and metadata.")
(defclass content ()
((tags :initform nil :initarg :tags :accessor content-tags)
(slug :initform nil :initarg :slug :accessor content-slug)
(date :initform nil :initarg :date :accessor content-date)))
(defun construct (content-type args)
"Create an instance of CONTENT-TYPE with the given ARGS."
(apply 'make-instance content-type args))
(defgeneric discover (content-type)
(:documentation "Load all content of the given CONTENT-TYPE from disk."))
(defgeneric publish (content-type)
(:documentation "Write pages to disk for all content of the given CONTENT-TYPE."))
(defun read-content (file &optional plist-p)
"Returns two values, a list of metadata from FILE, and the content as a string.
If PLIST-P is non-nil, a single plist is returned with :content holding the text."
(flet ((slurp-remainder (stream)
(let ((seq (make-string (- (file-length stream)
(file-position stream)))))
(read-sequence seq stream)
(remove #\Nul seq)))
(parse-field (str)
(nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
(field-name (line)
(make-keyword (string-upcase (subseq line 0 (position #\: line)))))
(read-delimited (str &optional (delimiter ", "))
(mapcar #'string-downcase (cl-ppcre:split delimiter str))))
(with-open-file (in file)
(unless (string= (read-line in) ";;;;;")
(error "The provided file lacks the expected header."))
(let ((meta (loop for line = (read-line in nil)
until (string= line ";;;;;")
appending (list (field-name line)
(aref (parse-field line) 0))))
(content (slurp-remainder in)))
(setf (getf meta :tags) (read-delimited (getf meta :tags)))
(if plist-p
(append meta (list :content content))
(values meta content))))))
(defun find-all (content-type)
"Return a list of all instances of a given CONTENT-TYPE."
(loop for val being the hash-values in *content*
when (eql content-type (type-of val)) collect val))
(defun purge-all (content-type)
"Remove all instances of CONTENT-TYPE from *content*."
(dolist (obj (find-all content-type))
(remhash (content-slug obj) *content*)))
(defmacro do-ctypes (&body body)
"Iterate over the subclasses of CONTENT performing BODY with ctype lexically
bound to the current subclass."
`(loop for ctype in (closer-mop:class-direct-subclasses (find-class 'content))
do ,@body))
(defun load-content ()
"Load all content stored in the blog's repo."
(do-ctypes (discover (class-name ctype))))
(defun by-date (content)
"Sort CONTENT in reverse chronological order."
(sort content #'string> :key #'content-date))
(defun slug-char-p (char)
"Determine if CHAR is a valid slug (i.e. URL) character."
(or (char<= #\0 char #\9)
(char<= #\a char #\z)
(char<= #\A char #\Z)
(member char '(#\_ #\- #\.))))
(defun slugify (string)
"Return a version of STRING suitable for use as a URL."
(remove-if-not #'slug-char-p (substitute #\- #\Space string)))

12
src/indices.lisp
View file

@ -29,25 +29,21 @@
(defun all-months ()
"Retrieve a list of all months with published posts."
(sort (remove-duplicates (mapcar (lambda (x) (get-month (post-date x)))
(hash-table-values *posts*)) :test #'string=)
(hash-table-values *content*)) :test #'string=)
#'string>))
(defun all-tags ()
"Retrieve a list of all tags used in posts."
(sort (remove-duplicates (mappend 'post-tags (hash-table-values *posts*))
(sort (remove-duplicates (mappend 'content-tags (hash-table-values *content*))
:test #'string=) #'string<))
(defun get-month (timestamp)
"Extract the YYYY-MM portion of TIMESTAMP."
(subseq timestamp 0 7))
(defun by-date (posts)
"Sort POSTS in reverse chronological order."
(sort posts #'string> :key #'post-date))
(defun index-by-tag (tag posts)
"Return an index of all POSTS matching the given TAG."
(let ((content (remove-if-not (lambda (post) (member tag (post-tags post)
(let ((content (remove-if-not (lambda (post) (member tag (content-tags post)
:test #'string=)) posts)))
(make-instance 'tag-index :id tag
:posts content
@ -71,7 +67,7 @@
(defun render-indices ()
"Render the indices to view posts in groups of size N, by month, and by tag."
(let ((posts (by-date (hash-table-values *posts*))))
(let ((posts (by-date (hash-table-values *content*))))
(dolist (tag (all-tags))
(let ((index (index-by-tag tag posts)))
(write-page (page-path index) (render-page index))))

77
src/posts.lisp
View file

@ -1,13 +1,7 @@
(in-package :coleslaw)
(defparameter *posts* (make-hash-table :test #'equal)
"A hash table to store all the posts and their metadata.")
(defclass post ()
((slug :initform nil :initarg :slug :accessor post-slug)
(title :initform nil :initarg :title :accessor post-title)
(tags :initform nil :initarg :tags :accessor post-tags)
(date :initform nil :initarg :date :accessor post-date)
(defclass post (content)
((title :initform nil :initarg :title :accessor post-title)
(format :initform nil :initarg :format :accessor post-format)
(content :initform nil :initarg :content :accessor post-content)))
@ -18,59 +12,26 @@
:next next)))
(defmethod page-path ((object post))
(rel-path (staging *config*) "posts/~a" (post-slug object)))
(rel-path (staging *config*) "posts/~a" (content-slug object)))
(defun read-post (in)
"Make a POST instance based on the data from the stream IN."
(flet ((check-header ()
(unless (string= (read-line in) ";;;;;")
(error "The provided file lacks the expected header.")))
(parse-field (str)
(nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
(field-name (line)
(subseq line 0 (position #\: line)))
(read-tags (str)
(mapcar #'string-downcase (cl-ppcre:split ", " str)))
(slurp-remainder ()
(let ((seq (make-string (- (file-length in) (file-position in)))))
(read-sequence seq in)
(remove #\Nul seq))))
(check-header)
(let ((args (loop for line = (read-line in nil) until (string= line ";;;;;")
appending (list (make-keyword (string-upcase (field-name line)))
(aref (parse-field line) 0)))))
(setf (getf args :tags) (read-tags (getf args :tags))
(getf args :format) (make-keyword (string-upcase (getf args :format))))
(apply 'make-instance 'post
(append args (list :content (render-content (slurp-remainder)
(getf args :format))
:slug (slugify (getf args :title))))))))
(defmethod initialize-instance :after ((post post) &key)
(with-accessors ((title post-title)
(format post-format)
(content post-content)) post
(setf (content-slug post) (slugify title)
format (make-keyword (string-upcase format))
content (render-content content format))))
(defun load-posts ()
"Read the stored .post files from the repo."
(clrhash *posts*)
(defmethod discover ((content-type (eql :post)))
(purge-all 'post)
(do-files (file (repo *config*) "post")
(with-open-file (in file)
(let ((post (read-post in)))
(if (gethash (post-slug post) *posts*)
(error "There is already an existing post with the slug ~a."
(post-slug post))
(setf (gethash (post-slug post) *posts*) post))))))
(let ((post (construct :post (read-content file t))))
(if (gethash (content-slug post) *content*)
(error "There is already an existing post with the slug ~a."
(content-slug post))
(setf (gethash (content-slug post) *content*) post)))))
(defun render-posts ()
"Iterate through the files in the repo to render+write the posts out to disk."
(loop for (prev post next) on (append '(nil) (sort (hash-table-values *posts*)
#'string< :key #'post-date))
(defmethod publish ((content-type (eql :post)))
(loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))
while post do (write-page (page-path post)
(render-page post nil :prev prev :next next))))
(defun slug-char-p (char)
"Determine if CHAR is a valid slug (i.e. URL) character."
(or (char<= #\0 char #\9)
(char<= #\a char #\z)
(char<= #\A char #\Z)
(member char '(#\_ #\- #\.))))
(defun slugify (string)
"Return a version of STRING suitable for use as a URL."
(remove-if-not #'slug-char-p (substitute #\- #\Space string)))