added sitemap generation

src/coleslaw.lisp

@@ -12,14 +12,18 @@
       (with-output-to-string (str)
         (3bmd:parse-string-and-print-to-stream text str)))))
 
-(defgeneric page-path (object)
+(defgeneric page-url (object)
-  (:documentation "The path to store OBJECT at once rendered."))
+  (:documentation "The url to the object, without the domain"))
 
-(defmethod page-path :around ((object t))
+(defmethod page-url :around ((object t))
   (let ((result (call-next-method)))
-    (if (pathname-type result)
+    (namestring (if (pathname-type result)
-        result
+                  result
-        (make-pathname :type "html" :defaults result))))
+                  (make-pathname :type "html" :defaults result)))))
+
+(defun page-path (object)
+  "The path to store OBJECT at once rendered."
+  (rel-path (staging-dir *config*) (page-url object)))
 
 (defun render-page (content &optional theme-fn &rest render-args)
   "Render the given CONTENT to disk using THEME-FN if supplied.
@@ -51,6 +55,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
       (when (probe-file dir)
         (run-program "cp -R ~a ." dir)))
     (do-ctypes (publish ctype))
+    (render-sitemap)
     (render-indices)
     (render-feeds (feeds *config*))))
 

src/content.lisp

@@ -7,6 +7,9 @@
   ((name :initform nil :initarg :name :accessor tag-name)
    (slug :initform nil :Initarg :slug :accessor tag-slug)))
 
+(defmethod page-url ((object tag))
+  (format nil "tag/~a" (tag-slug object)))
+
 (defun make-tag (str)
   "Takes a string and returns a TAG instance with a name and slug."
   (let ((trimmed (string-trim " " str)))

src/feeds.lisp

@@ -4,6 +4,20 @@
   "Make a RFC1123 pubdate representing the current time."
   (local-time:format-rfc1123-timestring nil (local-time:now)))
 
+(defun render-sitemap ()
+  "Render sitemap.xml under document root"
+  (let* ((template (theme-fn :sitemap "feeds"))
+         (urls (cons "" ; for root url
+                     (append (mapcar #'page-url (find-all 'post))
+                             (mapcar #'page-url (all-tags))
+                             (mapcar #'(lambda (m)
+                                         (format nil "date/~a.html" m))
+                                     (all-months)))))
+         (index (make-instance 'url-index
+                               :id "sitemap.xml"
+                               :urls urls)))
+    (write-page (page-path index) (render-page index template))))
+
 (defun render-feed (posts &key path template tag)
   (flet ((first-10 (list) (subseq list 0 (min (length list) 10)))
          (tag-posts (list) (remove-if-not (lambda (x) (tag-p tag x)) list)))

src/indices.lisp

@@ -16,15 +16,13 @@
 (defclass tag-index (index) ())
 (defclass date-index (index) ())
 (defclass int-index (index) ())
+(defclass url-index (index)
+  ((urls :initform nil :initarg :urls :accessor urls)))
 
-(defmethod page-path ((object index))
+(defmethod page-url ((object index))
-  (rel-path (staging-dir *config*) (index-id object)))
+  (index-id object))
-(defmethod page-path ((object tag-index))
+(defmethod page-url ((object date-index))
-  (rel-path (staging-dir *config*) "tag/~a" (index-id object)))
+  (format nil "date/~a" (index-id object)))
-(defmethod page-path ((object date-index))
-  (rel-path (staging-dir *config*) "date/~a" (index-id object)))
-(defmethod page-path ((object int-index))
-  (rel-path (staging-dir *config*) "~d" (index-id object)))
 
 (defun all-months ()
   "Retrieve a list of all months with published content."
@@ -40,7 +38,7 @@
 
 (defun index-by-tag (tag content)
   "Return an index of all CONTENT matching the given TAG."
-  (make-instance 'tag-index :id (tag-slug tag)
+  (make-instance 'tag-index :id (page-url tag)
                  :posts (remove-if-not (lambda (x) (tag-p tag x)) content)
                  :title (format nil "Posts tagged ~a" (tag-name tag))))
 
@@ -54,7 +52,7 @@
   "Return the index for the Ith page of CONTENT in reverse chronological order."
   (let* ((start (* step i))
          (end (min (length content) (+ start step))))
-    (make-instance 'int-index :id (1+ i)
+    (make-instance 'int-index :id (format nil "~d" (1+ i))
                               :posts (subseq content start end)
                               :title "Recent Posts")))
 

src/posts.lisp

@@ -10,8 +10,8 @@
                                   :prev prev
                                   :next next)))
 
-(defmethod page-path ((object post))
+(defmethod page-url ((object post))
-  (rel-path (staging-dir *config*) "posts/~a" (content-slug object)))
+  (rel-path "posts/~a" (content-slug object)))
 
 (defmethod initialize-instance :after ((object post) &key)
   (with-accessors ((title post-title)

themes/sitemap.tmpl

@@ -0,0 +1,12 @@
+{namespace coleslaw.theme.feeds}
+
+{template sitemap}
+<?xml version="1.0"?>{\n}
+<urlset xmlns='http://www.sitemaps.org/schemas/sitemap/0.9'>
+    {foreach $url in $content.urls}
+    <url>
+        <loc>{$config.domain}{$url}</loc>
+    </url>
+    {/foreach}
+</urlset>
+{/template}