Add RSS generation

3 files changed, 82 insertions, 20 deletions

diff --git a/feed.scm b/feed.scm
index 546fcc6..de1d4ac 100644
--- a/feed.scm
+++ b/feed.scm
@@ -2,8 +2,25 @@
   (import scheme
 	  (chicken base)
 	  (chicken format)
-	  atom)
+	  (chicken file)
+	  (chicken io)
+	  (chicken process)
+	  (chicken pathname)
+	  utils)
 
-  (define (generate-feed archive-dir)
-    ;; TODO generate feed with https://wiki.call-cc.org/eggref/5/atom or pandoc-rss
-    (printf "TODO generate-feed \"~A\"~%" archive-dir)))
+  (define (generate-feed archive-dir out-dir)
+    (define paths (glob (format "~A/*" archive-dir)))
+    (define output-port
+      (process "pandoc-rss"
+	       (apply list "-s"
+		      "-t" "jan's garden"
+		      "-d" "RSS feed for Jan's personal digital garden"
+		      "-l" "https://jan.systems"
+		      "-f" "%s"
+		      "-n" "en-GB"
+		      "-c" "CC BY-SA 4.0"
+		      "-w" "https://jan.systems"
+		      paths)))
+    (define output (read-string #f output-port))
+    (with-output-to-file (make-pathname out-dir "feed.xml")
+      (λ () (print output)))))
diff --git a/main.scm b/main.scm
index d396120..c8feac5 100644
--- a/main.scm
+++ b/main.scm
@@ -1,3 +1,6 @@
+(load "utils.scm")
+(load "feed.scm")
+
 (import (chicken base)
 	(chicken io)
 	(chicken file posix)
@@ -7,13 +10,14 @@
 	(chicken format)
 	(chicken process-context)
 	(chicken process)
+	srfi-18
 	matchable
 
 	utils
 	feed
 	)
 
-; application
+;; application
 
 (define src-dir (or (get-environment-variable "SRC_DIR")
 		    "pages"))
@@ -41,10 +45,46 @@
 (define (process-md md-path)
   (printf "[info] converting markdown file \"~A\"" md-path)
   (define out-html-file (pipe md-path
-			      (λ (p) (irregex-replace (format "^~A" src-dir) p out-dir))
-			      (λ (p) (irregex-replace "\.md$" p ".html"))))
+			      (@ replace (format "^~A" src-dir) out-dir)
+			      (@ replace "\\.md$" ".html")))
   (printf " to \"~A\"~%" out-html-file)
-  (pandoc-md-to-html md-path out-html-file))
+  (define preprocessed-md-path (preprocess-md md-path))
+  (pandoc-md-to-html preprocessed-md-path out-html-file))
+
+(define (preprocess-md md-path)
+  (define md (with-input-from-file md-path
+	       (λ () (read-string #f))))
+
+  (define cwd (decompose-pathname md-path))
+
+  ;;(define wiki-image-irx "\\!\\[\\[(.+?)\\]\\]")
+  ;;(define (wiki-image-replace m) (format "![](/files/~A)" (submatch m)))
+  ;;(define result (pipe md (@ replace-all wiki-image-irx wiki-image-replace)))
+
+  ;; Matches markdown links
+  (define irx "\\[(.+?)\\]\\((.+?)\\)")
+  (define (link-replace m)
+    (define alt (submatch m 1))
+    (define link (submatch m 2))
+
+    ;; if link is absolute or external, leave as is.
+    ;; otherwise, normalize it to the current context
+    (define ret-link
+      (if (or (substring=? "https://" link) (substring=? "/" link))
+	  link
+	  ;; else
+	  (normalize-pathname (make-pathname cwd link))))
+
+    (define rooted (replace (format "^~A\\/?" src-dir) "/" ret-link))
+    (format "[~A](~A)" alt rooted))
+
+  (define result (replace-all irx link-replace md))
+
+  (define out-file (create-temporary-file ".md"))
+  (with-output-to-file out-file
+    (λ () (print result)))
+
+  out-file)
 
 (define (pandoc-md-to-html md-path html-path)
   (define args (list md-path
@@ -52,22 +92,25 @@
 		     "--standalone"
 		     "--template" template-path
 		     "--highlight-style" "pygments"))
-  (process "pandoc" args))
+  (define output-port (process "pandoc" args))
+  ;; read and discard output in order to wait for completion
+  (read-string #f output-port)
+  #f)
 
 (define (process-other-file path)
-    (printf "[info] copying other file \"~A\"" path)
-    (define out-path (replace (format "^~A" src-dir) out-dir path))
-    (printf " to \"~A\"~%" out-path)
-    (copy-file path out-path))
+  (printf "[info] copying other file \"~A\"" path)
+  (define out-path (replace (format "^~A" src-dir) out-dir path))
+  (printf " to \"~A\"~%" out-path)
+  (copy-file path out-path))
 
 (define (process-dir dir-path)
-  (printf "[info] processing directory ~A~%" dir-path)
+  (printf "[info] processing directory \"~A\"~%" dir-path)
   (define out-dir-path (replace (format "^~A" src-dir) out-dir dir-path))
   (create-directory out-dir-path #t)
   (define paths (pipe dir-path
 		      (@ format "~A/*")
 		      (@ glob)
-		      (@ map (@ replace "^\./" ""))))
+		      (@ map (@ replace "^\\.\\/" ""))))
 
   (for-each process-path paths))
 
@@ -78,12 +121,12 @@
 	(delete-file path)))
   (for-each (@ delete) (glob (format "~A/*" dir))))
 
-; run
+;; run
 
+(printf "[info] generating feed from directory \"~A\"~%" feed-dir)
+(generate-feed feed-dir out-dir)
 (printf "[info] cleaning up output directory \"~A\"~%" out-dir)
 (clean-dir out-dir)
 (printf "[info] generating site with pages from \"~A\"~%" src-dir)
 (process-dir src-dir)
-(printf "[info] generating feed~%")
-(generate-feed feed-dir)
 (printf "[info] done.~%")
diff --git a/utils.scm b/utils.scm
index 0d10b6d..9bb290e 100644
--- a/utils.scm
+++ b/utils.scm
@@ -31,6 +31,8 @@
     (irregex-replace irx in replacement))
 
   (define (replace-all irx replacement in)
-    (irregex-replace/all irx in replacement))  
+    (irregex-replace/all irx in replacement))
+
+  (define (submatch m #!optional (index 1))
+    (irregex-match-substring m index))
   )
-q