From 4f68a4c30a629fbdd4d20a36960340c5735194c8 Mon Sep 17 00:00:00 2001
From: Alexander Artemenko <svetlyak.40wt@gmail.com>
Date: Sun, 7 Apr 2024 15:29:32 +0300
Subject: [PATCH] Real sitemap generator.

---
 src/feeds/base.lisp      | 17 +++++++++++++++--
 src/index/base.lisp      | 11 +++++++++++
 src/plugins/sitemap.lisp | 13 +++++++++++--
 3 files changed, 37 insertions(+), 4 deletions(-)

diff --git a/src/feeds/base.lisp b/src/feeds/base.lisp
index e897e91..ae31fa4 100644
--- a/src/feeds/base.lisp
+++ b/src/feeds/base.lisp
@@ -14,7 +14,11 @@
                 #:postp
                 #:post)
   (:import-from #:local-time
-                #:timestamp>))
+                #:timestamp>)
+  (:import-from #:staticl/url
+                #:object-url)
+  (:import-from #:staticl/current-root
+                #:current-root))
 (in-package #:staticl/feeds/base)
 
 
@@ -47,7 +51,8 @@
 
 
 (defmethod staticl/content:get-target-filename ((site site) (feed-file feed-file) (stage-dir pathname))
-  (merge-pathnames (target-path feed-file)
+  (merge-pathnames (target-path
+                    feed-file)
                    stage-dir))
 
 
@@ -65,6 +70,7 @@
                                  sorted-items))))
   (values))
 
+
 (defmethod staticl/content:write-content-to-stream ((site site) (feed-file feed-file) stream)
   (loop for item in (content-items feed-file)
         for feed-entry = (make-instance 'org.shirakumo.feeder:entry
@@ -84,3 +90,10 @@
                   (plump-node (org.shirakumo.feeder:serialize-feed feed
                                                                    (feed-type feed-file))))
              (plump:serialize plump-node stream))))
+
+
+(defmethod object-url ((feed-file feed-file) &key &allow-other-keys)
+  (let* ((root (current-root))
+         (relative-path (enough-namestring (target-path feed-file)
+                                           root)))
+    (uiop:unix-namestring relative-path)))
diff --git a/src/index/base.lisp b/src/index/base.lisp
index 6a9a5d6..6f205e5 100644
--- a/src/index/base.lisp
+++ b/src/index/base.lisp
@@ -12,6 +12,10 @@
                 #:site)
   (:import-from #:staticl/theme
                 #:template-vars)
+  (:import-from #:staticl/url
+                #:object-url)
+  (:import-from #:staticl/current-root
+                #:current-root)
   (:export #:index-page
            #:page-items
            #:prev-page
@@ -116,3 +120,10 @@
   (if (next-method-p)
       (call-next-method content :hash hash)
       (values hash)))
+
+
+(defmethod object-url ((index index-page) &key &allow-other-keys)
+  (let* ((root (current-root))
+         (relative-path (enough-namestring (page-target-path index)
+                                           root)))
+    (uiop:unix-namestring relative-path)))
diff --git a/src/plugins/sitemap.lisp b/src/plugins/sitemap.lisp
index 7b4913c..206c1a5 100644
--- a/src/plugins/sitemap.lisp
+++ b/src/plugins/sitemap.lisp
@@ -10,7 +10,12 @@
   (:import-from #:staticl/site
                 #:site)
   (:import-from #:serapeum
-                #:soft-list-of))
+                #:soft-list-of)
+  (:import-from #:cl-sitemaps/builder
+                #:make-url
+                #:render-sitemap)
+  (:import-from #:staticl/url
+                #:object-url))
 (in-package #:staticl/plugins/sitemap)
 
 
@@ -42,7 +47,11 @@
 
 
 (defmethod write-content-to-stream ((site site) (sitemap sitemap-file) (stream stream))
-  (write-string "TODO: make-sure to implement sitemaps" stream))
+  (render-sitemap (loop for item in (sitemap-content sitemap)
+                        collect (make-url (object-url item :full t)
+                                          :changefreq :weekly
+                                          :priority 0.5))
+                  :stream stream))
 
 
 (defmethod staticl/pipeline:process-items ((site site) (node sitemap) content-items)