Use a single pipeline and render RSS feed.

example/.staticlrc

@@ -1,3 +1,12 @@
 ;;; -*- mode : lisp -*-
-(:title "Example Staticl Site"
- :plugins ((sitemap)))
+(site "Example Static Site"
+      :description "Just an example of the static file generated by StatiCL."
+      :url "https://example.com/"
+      :pipeline (list (load-content)
+                      (filter (:path "ru/")
+                              (rss :target-path #P"ru/blog/rss.xml"))
+                      (filter (:path "ru/" :invert t)
+                              (rss :target-path #P"blog/rss.xml"))
+                      (sitemap)
+                      ;; (rsync "my-site")
+                      ))

example/blog/first.post

@@ -10,3 +10,6 @@ I believe, that software should evolve and evolve quickly.
 One of the reasons why Common Lisp seems strange to newcomers is its
 ecosystem. It takes a long time to add a new library and make it useful
 to other common lispers.
+
+This post contains some *Markdown* markup.
+

src/content.lisp

@@ -36,6 +36,13 @@
                 #:tag)
   (:import-from #:staticl/format
                 #:to-html)
+  (:import-from #:staticl/url
+                #:object-url)
+  (:import-from #:staticl/current-root
+                #:current-root)
+  (:import-from #:staticl/content/html-content
+                #:content-html-excerpt
+                #:content-html)
   (:export #:supported-content-types
            #:content-type
            #:content
@@ -48,7 +55,15 @@
            #:get-target-filename
            #:content-with-title-mixin
            #:content-with-tags-mixin
-           #:content-from-file))
+           #:content-from-file
+           #:load-content
+           #:content-created-at
+           #:content-format
+           #:content-template
+           #:content-file
+           #:content-text
+           #:content-title
+           #:content-excerpt-separator))
 (in-package #:staticl/content)
 
 
@@ -110,11 +125,19 @@
          :type pathname
          :reader content-file
          :documentation "Absolute pathname to the file read from disk or NIL for content objects which have no source file, like RSS feeds.")
+   (url :initarg :url
+        :type (or null string)
+        :documentation "Page's URL or a path relative to Site's URL.")
    (text :initarg :text
          :type string
-         :reader content-text))
+         :reader content-text)
+   (excerpt-separator :initarg :excerpt
+                      :type string
+                      :reader content-excerpt-separator))
   (:default-initargs
-   :template (error "Please, specify :TEMPLATE initarg in subclass of CONTENT-FROM-FILE.")))
+   :template (error "Please, specify :TEMPLATE initarg in subclass of CONTENT-FROM-FILE.")
+   :url nil
+   :excerpt "<!--more-->"))
 
 
 (defmethod print-items append ((obj content-from-file))
@@ -223,6 +246,16 @@
        stage-dir))))
 
 
+(defmethod object-url ((content content-from-file))
+  (or (slot-value content 'url)
+      (let* ((root (current-root))
+             (relative-path (enough-namestring (content-file content)
+                                               root)))
+        (uiop:unix-namestring
+         (merge-pathnames (make-pathname :type "html")
+                          relative-path)))))
+
+
 (defgeneric write-content-to-stream (site content stream)
   (:documentation "Writes CONTENT object to the STREAM using given FORMAT.")
 
@@ -250,12 +283,28 @@
       (values hash)))
 
 
+(defmethod content-html ((content content-from-file))
+  (to-html (content-text content)
+           (content-format content)))
+
+
+
+(defmethod content-html-excerpt ((content content-from-file))
+  (let* ((separator (content-excerpt-separator content))
+         (full-content (content-text content))
+         (excerpt (first
+                   (str:split separator
+                              full-content
+                              :limit 2))))
+    (to-html excerpt
+             (content-format content))))
+
+
 (defmethod template-vars ((content content-from-file) &key (hash (dict)))
   (setf (gethash "title" hash)
         (content-title content)
         (gethash "html" hash)
-        (to-html (content-text content)
-                 (content-format content))
+        (content-html content)
         (gethash "created-at" hash)
         (content-created-at content)
 
@@ -287,3 +336,17 @@
   (if (next-method-p)
       (call-next-method content :hash hash)
       (values hash)))
+
+
+
+(defclass load-content ()
+  ())
+
+
+(defun load-content ()
+  (make-instance 'load-content))
+
+
+(defmethod staticl/pipeline:process-items ((site site) (node load-content) content-items)
+  (loop for new-item in (read-contents site)
+        do (staticl/pipeline:produce-item new-item)))

src/content/html-content.lisp

@@ -0,0 +1,12 @@
+(uiop:define-package #:staticl/content/html-content
+  (:use #:cl)
+  (:export #:content-html
+           #:content-html-excerpt))
+(in-package #:staticl/content/html-content)
+
+
+(defgeneric content-html (content)
+  (:documentation "Returns a content as HTML string."))
+
+(defgeneric content-html-excerpt (content)
+  (:documentation "Returns an excerpt of full content as HTML string."))

src/core.lisp

@@ -1,6 +1,7 @@
 (uiop:define-package #:staticl
   (:use #:cl)
   (:import-from #:staticl/site
+                #:site-content-root
                 #:site-theme
                 #:site-plugins
                 #:make-site)
@@ -12,6 +13,13 @@
                 #:->)
   (:import-from #:staticl/theme
                 #:copy-static)
+  (:import-from #:staticl/pipeline
+                #:execute-pipeline)
+  (:import-from #:staticl/current-root
+                #:with-current-root)
+  (:import-from #:staticl/url
+                #:object-url
+                #:with-base-url)
   (:nicknames #:staticl/core)
   (:export #:generate
            #:stage))
@@ -28,16 +36,21 @@
                 (stage-dir (merge-pathnames (make-pathname :directory '(:relative "stage"))
                                             (uiop:ensure-directory-pathname root-dir))))
   (let* ((site (make-site root-dir))
-         (initial-content (read-contents site))
-         (plugins (site-plugins site))
-         (additional-content
-           (loop for plugin in plugins
-                 append (preprocess site plugin
-                                    initial-content)))
-         (all-content (append initial-content
-                              additional-content)))
-    (loop for content in all-content
-          do (write-content site content stage-dir))
+         ;; (initial-content (read-contents site))
+         ;; (plugins (site-plugins site))
+         ;; (additional-content
+         ;;   (loop for plugin in plugins
+         ;;         append (preprocess site plugin
+         ;;                            initial-content)))
+         ;; (all-content (append initial-content
+         ;;                      additional-content))
+         (all-content (execute-pipeline site))
+         )
+
+    (with-current-root ((site-content-root site))
+      (with-base-url ((object-url site))
+        (loop for content in all-content
+              do (write-content site content stage-dir))))
 
     (copy-static (site-theme site)
                  stage-dir)

src/current-root.lisp

@@ -0,0 +1,40 @@
+(uiop:define-package #:staticl/current-root
+  (:use #:cl)
+  (:import-from #:serapeum
+                #:directory-pathname
+                #:->)
+  (:import-from #:alexandria
+                #:with-gensyms)
+  (:export #:with-current-root
+           #:current-root))
+(in-package #:staticl/current-root)
+
+
+(declaim (type directory-pathname *current-root*))
+
+(defvar *current-root*)
+
+
+(-> current-root ()
+    (values directory-pathname &optional))
+
+(defun current-root ()
+  (unless (boundp '*current-root*)
+    (error "Function CURRENT-ROOT should be called inside WITH-CURRENT-ROOT scope."))
+  (values *current-root*))
+
+
+(-> call-with-current-root (directory-pathname function))
+
+(defun call-with-current-root (root thunk)
+  (let ((*current-root* (uiop:ensure-absolute-pathname
+                         (uiop:ensure-directory-pathname root))))
+    (funcall thunk)))
+
+
+(defmacro with-current-root ((root) &body body)
+  (with-gensyms (thunk)
+    `(flet ((,thunk ()
+              ,@body))
+       (declare (dynamic-extent #',thunk))
+       (call-with-current-root ,root #',thunk))))

src/filter.lisp

@@ -0,0 +1,39 @@
+(uiop:define-package #:staticl/filter
+  (:use #:cl)
+  (:import-from #:serapeum
+                #:directory-pathname)
+  (:import-from #:staticl/site
+                #:site)
+  (:export #:filter))
+(in-package #:staticl/filter)
+
+
+(defclass filter ()
+  ((path :initarg :path
+         :type (or null directory-pathname)
+         :reader filter-path)
+   (invert :initarg :invert
+           :type boolean
+           :reader filter-invert)
+   (pipeline :initarg :pipeline
+             :type list
+             :reader pipeline-items))
+  (:default-initargs
+   :path nil
+   :invert nil
+   :pipeline nil))
+
+
+(defmacro filter ((&key path invert) &rest pipeline)
+  (alexandria:once-only (path)
+    `(make-instance 'filter
+                    :path (when ,path
+                            (uiop:ensure-directory-pathname ,path))
+                    :invert ,invert
+                    :pipeline (list ,@pipeline))))
+
+
+(defmethod staticl/pipeline:process-items ((site site) (node filter) content-items)
+  (let ((filtered content-items))
+    (loop for subnode in (pipeline-items node)
+          do (staticl/pipeline:process-items site subnode filtered))))

src/pipeline.lisp

@@ -0,0 +1,70 @@
+(uiop:define-package #:staticl/pipeline
+  (:use #:cl)
+  (:import-from #:staticl/site
+                #:site
+                #:site-pipeline)
+  (:import-from #:serapeum
+                #:soft-list-of
+                #:->)
+  (:import-from #:staticl/content
+                #:content)
+  (:export #:execute-pipeline
+           #:process-items
+           #:produce-item
+           #:remove-item))
+(in-package #:staticl/pipeline)
+
+
+(defgeneric process-items (site pipeline-node content-items)
+  (:documentation "A method for this generic function should process CONTENT-ITEMS - a list of conten items
+                   produced by a previous pipeline nodes.
+
+                   During the execution, method can call PRODUCE-ITEM or REMOVE-ITEM functions to add a new content
+                   or to remove some content item."))
+
+(defvar *produce-item-func*)
+
+(defun produce-item (item)
+  (funcall *produce-item-func* item))
+
+
+(defvar *remove-item-func*)
+
+(defun remove-item (item)
+  (funcall *remove-item-func* item))
+
+
+(-> execute-pipeline (site)
+    (values (soft-list-of content)))
+
+(defun execute-pipeline (site)
+  (let ((known-items nil)
+        (items-to-remove nil))
+    (flet ((produce-item-func (item)
+             (push item known-items)
+             (values))
+           (remove-item-func (item)
+             ;; Items to remove are pushed into an intermediate list
+             ;; just because there may be some siteeffects if we'll
+             ;; modify KNOWN-ITEMS list while iterating on it.
+             (push item items-to-remove)
+             (values)))
+      (declare (dynamic-extent #'produce-item-func
+                               #'remove-item-func))
+
+      (let ((*produce-item-func* #'produce-item-func)
+            (*remove-item-func* #'remove-item-func))
+        (loop for pipeline-node in (site-pipeline site)
+              do (process-items site pipeline-node known-items)
+                 (when items-to-remove
+                   ;; This is N*M complexity, but length of items-to-remove
+                   ;; usually should be relatively small.
+                   ;; It is possible to optimize this in future, for example
+                   ;; by remembering an index of the items to remove instead
+                   ;; of the item itself.
+                   (setf known-items
+                         (remove-if (lambda (item)
+                                      (member item items-to-remove))
+                                    known-items))
+                   (setf items-to-remove nil)))
+        (values known-items)))))

src/plugins/sitemap.lisp

@@ -18,15 +18,21 @@
   ())
 
 
+(defun sitemap ()
+  (make-instance 'sitemap))
+
+
 (defclass sitemap-file (content)
   ((contents :initarg :contents
              :type (soft-list-of content)
              :reader sitemap-content)))
 
 
 (defmethod preprocess ((site site) (sitemap sitemap) contents)
-  (list (make-instance 'sitemap-file
-                       :contents contents)))
+  (error "Old function will be removed!")
+  ;; (list (make-instance 'sitemap-file
+  ;;                      :contents contents))
+  )
 
 
 (defmethod get-target-filename ((site site) (sitemap sitemap-file) stage-dir)
@@ -37,3 +43,9 @@
 
 (defmethod write-content-to-stream ((site site) (sitemap sitemap-file) (stream stream))
   (write-string "TODO: make-sure to implement sitemaps" stream))
+
+
+(defmethod staticl/pipeline:process-items ((site site) (node sitemap) content-items)
+  (staticl/pipeline:produce-item
+   (make-instance 'sitemap-file
+                  :contents content-items)))