API changes, Static Indices rewrite and more...

* Revamp API intersection of indices and posts.
* Rewrite the static implementation of indices.
* Add split-sequence dep to coleslaw-static
* Various bugfixes and cleanups to import plugin.
* Beginnings of hunchentoot plugin.
* Update TODO.

TODO

@@ -12,15 +12,10 @@ TODO:
 ;;;; implement render-site!!!
 ;;;; how many globals can we move into *storage* as keywords? ALL OF THEM!
 ;;;; -- What about generics?
+;;;; write a proper version of escape considering wild pathnames and valid URL issues
 ;;;; implement atom feed. RSS too?
 ;;;; implement non-disqus comment support?
 ;;;; What do post update semantics look like? i.e. edit file to change tags.
-;;; indices
-;; what should it really look like, keeping in mind the API should be mostly
-;; identical between the static and dynamic backend?
-;; indexes should be id, type, title + posts. rewrite indices to use them.
-;;; posts
-;; post-url, improve escaping.
 
 ;;;; PLUGINS
 ;;;; add activate-plugin, deactivate-plugin, :active-plugins?

coleslaw-static.asd

@@ -5,7 +5,7 @@
   :maintainer "Brit Butler <redline6561@gmail.com>"
   :author "Brit Butler <redline6561@gmail.com>"
   :licence "LLGPL"
-  :depends-on (:coleslaw :trivial-timers :cl-store)
+  :depends-on (:coleslaw :trivial-timers :cl-store :split-sequence)
   :components ((:module static
                         :components ((:file "coleslaw")
                                      (:file "comments"

plugins/hunchentoot.lisp

@@ -0,0 +1,4 @@
+(ql:quickload '(hunchentoot))
+
+(in-package :coleslaw)
+

plugins/import.lisp

@@ -30,13 +30,13 @@ object is determined by SERVICE."))
              (let* ((date (split-sequence #\Space (subseq pubdate 5)))
                     (time (split-sequence #\: (fourth date))))
                (encode-timestamp 0
-                                 (parse-integer (third time)) ; sec
+                                 (parse-integer (third time))
-                                 (parse-integer (second time)) ; min
+                                 (parse-integer (second time))
-                                 (parse-integer (first time)) ; hr
+                                 (parse-integer (first time))
-                                 (parse-integer (first date)) ; day
+                                 (parse-integer (first date))
                                  (position (second date) +short-month-names+
-                                           :test #'string=) ; month
+                                           :test #'string=)
-                                 (parse-integer (third date)))))) ; year
+                                 (parse-integer (third date))))))
     (when (public-p)
       (let ((new-post (make-post (node-val "title")
                                  (node-val "category")
@@ -48,20 +48,20 @@ object is determined by SERVICE."))
             (comments (nodes "wp:comment")))
         (add-post new-post (post-id new-post))
         (when static-p
-          (write-post post))))))
+          (write-post new-post))))))
 
 (defun write-post (post)
-  (let ((filepath (merge-pathnames *input-dir*
+  (let ((filepath (merge-pathnames (format nil "~5,'0d-~a.html"
-                                   (format nil "~5d,'0/~a.html"
                                            (post-id post)
-                                           ;; TODO: Write + use escaping fn.
+                                           (coleslaw::escape (post-title post)))
-                                           (post-title post)))))
+                                   coleslaw::*input-directory*)))
-    (with-open-file (out filepath :direction :output :if-exists :supersede)
+    (with-open-file (out filepath :direction :output
+                         :if-exists :supersede :if-does-not-exist :create)
       ;; TODO: What other data/metadata should we write out?
       (format out ";;;;;~%")
       (format out "title: ~A~%" (post-title post))
-      (format out "tags: ~A~%" (pretty-tags (post-tags post)))
+      (format out "tags: ~A~%" (coleslaw::pretty-list (post-tags post)))
-      (format out "date: ~A~%" (pretty-date (post-date post)))
+      (format out "date: ~A~%" (coleslaw::pretty-date (post-date post)))
       (format out ";;;;;~%")
       (format out "~A~%" (post-content post)))))
 

src/indices.lisp

@@ -1,13 +1,24 @@
 (in-package :coleslaw)
 
-(defgeneric add-index (index id)
+(defclass index ()
-  (:documentation "Insert INDEX into *storage* with the given ID."))
+  ((id :initform nil :initarg :id
+       :accessor index-id)
+   (posts :initform nil :initarg :posts
+          :accessor index-posts)))
 
-(defgeneric remove-index (id)
+(defgeneric make-index (id posts)
-  (:documentation "Remove the index matching ID from *storage*."))
+  (:documentation "Create an INDEX with the given data."))
+
+(defgeneric add-to-index (id post)
+  (:documentation "Add POST to the index matching ID, creating INDEX if
+it does not exist."))
+
+(defgeneric remove-from-index (id post)
+  (:documentation "Remove POST from the index matching ID, removing INDEX if
+it holds no more posts."))
 
 (defgeneric render-index (id page)
-  (:documentation "Generate the final HTML for the index with given ID."))
+  (:documentation "Generate the final HTML for a given PAGE of the index ID."))
 
 (defgeneric find-index (id)
   (:documentation "Retrieve the index matching ID from *storage*."))

src/posts.lisp

@@ -30,15 +30,5 @@
 (defgeneric find-post (id)
   (:documentation "Retrieve a post from *storage* matching ID."))
 
-(defgeneric find-by-tag (tag)
-  (:documentation "Retrieve all posts from *storage* tagged with TAG."))
-
-(defgeneric find-by-date (date)
-  (:documentation "Retrieve all posts from *storage* matching DATE."))
-
-(defgeneric find-by-range (start end)
-  (:documentation "Retrieve all posts from *storage* with ids between
-START and END."))
-
 (defgeneric post-url (id)
   (:documentation "Return the URL for the post with the given ID."))

static/coleslaw.lisp

@@ -24,9 +24,12 @@ e.g. \"CC-BY-SA\". Otherwise, standard copyright is assumed.")
 
 (defun static-init ()
   (setf *storage* (make-hash-table))
-  (loop for table in '(:authors :comments :posts :indices :credentials)
+  (loop for table in '(:authors :comments :posts :credentials)
      do (unless (gethash table *storage*)
-          (setf (gethash table *storage*) (make-hash-table)))))
+          (setf (gethash table *storage*) (make-hash-table))))
+  (unless (gethash :indices *storage*)
+    (setf (gethash :indices *storage*)
+          (make-hash-table :test #'equal))))
 
 (defmethod start-coleslaw (&rest options)
   )

static/indices.lisp

@@ -1,51 +1,68 @@
 (in-package :coleslaw)
 
+(defmethod make-index (id posts)
+  (make-instance 'index :id id :posts posts))
+
+(defmethod find-index (id)
+  (gethash id (gethash :indices *storage*)))
+
+(defun (setf find-index) (new-val id)
+  (setf (gethash id (gethash :indices *storage*)) new-val)
+  new-val)
+
+(defmethod add-to-index (id (post post))
+  (let ((index (find-index id)))
+    (if index
+        (push post (index-posts index))
+        (setf index (make-index id (list post))))
+    (setf (find-index id) index)))
+
+(defmethod remove-from-index (id (post post))
+  (let ((index (find-index id)))
+    (setf (index-posts index) (remove post (index-posts index)))
+    (if (index-posts index)
+        (setf (find-index id) index)
+        (remhash id (gethash :indices *storage*)))))
+
 (defun monthlinks ()
-  (loop for month in (gethash :months-index *storage*)
+  (loop for month in (gethash :months-list *storage*)
-     collecting (list :url (index-url :date month) :name month)))
+     collecting (list :url (index-url (concatenate 'string "date/" month) 1)
+                      :name month)))
 
 (defun taglinks ()
-  (loop for tag in (gethash :tags-index *storage*)
+  (loop for tag in (gethash :tags-list *storage*)
-     collecting (list :url (index-url :tag tag) :name tag)))
+     collecting (list :url (index-url (concatenate 'string "tag/" tag) 1)
+                      :name tag)))
 
-(defun index-title (id &optional page)
+(defun index-title (id)
-  (case id
+  (let ((split-id (split-sequence:split-sequence #\/ id)))
-    (:range "Recent Posts")
+    (cond ((string= "date" (first split-id))
-    (:date (format nil "Posts from ~A" page))
+           (format nil "Posts from ~A" (second split-id)))
-    (:tag (format nil "Posts tagged ~A" page))))
+          ((string= "tag" (first split-id))
-
+           (format nil "Posts tagged ~A" (second split-id)))
-(defun index-posts (id page)
+          (t (format nil "Recent Posts")))))
-  (case id
-    (:range (let* ((count (hash-table-count (gethash :posts *storage*)))
-                   (start (- count (* 10 (1- page))))
-                   (end (- start 9)))
-              (remove nil (find-by-range start end))))
-    (:date (find-by-date page))
-    (:tag (find-by-tag page))))
 
 (defmethod render-index (id page)
-  (let* ((posts (index-posts id page))
+  (let* ((index-posts (index-posts (find-index id)))
+         (start (* 10 (1- page)))
+         (end (if (< (+ start 9) (length index-posts))
+                  (+ start 9)
+                  (- (length index-posts) start)))
+         (posts (subseq index-posts start end))
          (content (funcall (find-symbol "INDEX" (theme-package))
                            (list :taglinks (taglinks)
                                  :monthlinks (monthlinks)
-                                 :title (index-title id page)
+                                 :title (index-title id)
                                  :posts (loop for post in posts collect
                                              (list :url (post-url (post-id post))
                                                    :title (post-title post)
                                                    :date (pretty-date (post-date post))
                                                    :contents (post-content post)))
-                                 :prev (when (and (numberp id)
+                                 :prev (when (> page 1)
-                                                  (index-posts id (1- page)))
                                          (index-url id (1- page)))
-                                 :next (when (and (numberp id)
+                                 :next (when (< (* 10 page) (length index-posts))
-                                                  (index-posts id (1+ page)))
                                          (index-url id (1+ page)))))))
     content))
 
 (defmethod index-url (id page)
-  (flet ((keyword-name (keyword)
+  (concatenate 'string *site-root* "/" id "/" (write-to-string page)))
-           (format nil "~A" keyword)))
-    (if (member id '(:date :tag))
-        (concatenate 'string *site-root* "/"
-                     (string-downcase (keyword-name id)) "/" page)
-        (concatenate 'string *site-root* "/page/" (write-to-string page)))))

static/posts.lisp

@@ -8,23 +8,38 @@
                  :content content
                  :aliases aliases))
 
+(defmethod find-post (id)
+  (gethash id (gethash :posts *storage*)))
+
+(defun (setf find-post) (new-val id)
+  (setf (gethash id (gethash :posts *storage*)) new-val)
+  new-val)
+
 (defmethod add-post ((post post) id)
-  (setf (gethash id (gethash :posts *storage*)) post)
+  (setf (find-post id) post)
-  (loop for tag in (post-tags post)
+  (add-to-index "recent" post)
-     do (pushnew tag (gethash :tags-index *storage*) :test #'string=))
+  (loop for tag in (post-tags post) do
-  (let ((date (post-date post))
+       (pushnew tag (gethash :tags-list *storage*) :test #'string=)
-        (month (format nil "~4d-~2,'0d" (local-time:timestamp-year date)
+       (add-to-index (concatenate 'string "tag/" tag) post))
-                       (local-time:timestamp-month date))))
+  (let ((year-month (year-month (post-date post))))
-    (pushnew month (gethash :months-index *storage*) :test #'string=)))
+    (pushnew (year-month (post-date post))
+             (gethash :months-list *storage*) :test #'string=)
+    (add-to-index (concatenate 'string "date/" year-month) post)))
 
 (defmethod remove-post (id)
-  (setf (gethash id (gethash :posts *storage*)) nil))
+  ;; Removes post from storage and indexes but not disk! Should we support more?
+  (let ((post (find-post id)))
+    (loop for tag in (post-tags post) do
+         (remove-from-index (concatenate 'string "tag/" tag) post))
+    (remove-from-index (concatenate 'string "date/"
+                                    (month-year (post-date post))))
+    (setf (find-post id) nil)))
 
 (defmethod render-post (id)
   (let* ((post (find-post id))
          (result (funcall (theme-fn "POST")
                           (list :title (post-title post)
-                                :tags (pretty-tags (post-tags post))
+                                :tags (pretty-list (post-tags post))
                                 :date (pretty-date (post-date post))
                                 :content (post-content post)
                                 :prev (when (find-post (1- id))
@@ -33,36 +48,8 @@
                                         (post-url (1+ id)))))))
     result))
 
-(defmethod find-post (id)
-  (gethash id (gethash :posts *storage*)))
-
-(defmethod find-by-tag (tag)
-  (let ((results nil))
-    (loop for post being the hash-values in (gethash :posts *storage*)
-       do (when (member tag (post-tags post) :test #'string=)
-            (push post results)))
-    results))
-
-(defmethod find-by-date (year-month)
-  (let ((results nil)
-        (year (parse-integer (subseq year-month 0 4)))
-        (month (parse-integer (subseq year-month 5))))
-    (loop for post being the hash-values in (gethash :posts *storage*)
-       do (let ((date (post-date post)))
-            (when (and (= year (local-time:timestamp-year date))
-                       (= month (local-time:timestamp-month date)))
-              (push post results))))
-    (sort results #'local-time:timestamp> :key #'post-date)))
-
-(defmethod find-by-range (start end)
-  (if (> start end)
-      (loop for id from start downto end collecting (find-post id))
-      (loop for id from start upto end collecting (find-post id))))
-
 (defmethod post-url (id)
-  (flet ((escape (str)
+  (let ((post (find-post id)))
-           (substitute #\- #\Space str)))
+    (concatenate 'string *site-root* "/"
-    (let ((post (find-post id)))
+                 (year-month (post-date post)) "/"
-      (concatenate 'string *site-root* "/"
+                 (escape (post-title post)))))
-                   (year-month (post-date post)) "/"
-                   (escape (post-title post))))))

static/util.lisp

@@ -12,3 +12,8 @@
 
 (defun theme-fn (name)
   (find-symbol name (theme-package)))
+
+(defun escape (str)
+  (substitute #\. #\/
+              (substitute #\_ #\?
+                          (substitute #\- #\Space str))))