From 953db5c6d3ffc07cd90bce25ddd266e9338f1d86 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 13 Jan 2022 06:38:51 +0100
Subject: Insert error messages into rss feed.

Errors which no-one sees are the worst, and what better place than where
someone who cares is expected to look!
---
 module/rss-filter.scm | 46 ++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 44 insertions(+), 2 deletions(-)

diff --git a/module/rss-filter.scm b/module/rss-filter.scm
index 748fa77..1138744 100644
--- a/module/rss-filter.scm
+++ b/module/rss-filter.scm
@@ -1,15 +1,40 @@
 (define-module (rss-filter)
   :export (handle-feed)
   :use-module (ice-9 curried-definitions)
+  :use-module (ice-9 match)
   :use-module (rss-filter feed-handler)
   :use-module (web client)
   :use-module (web response)
   :use-module (sxml simple)
   :use-module (sxml xpath)
   :use-module (sxml namespace)
+
   :use-module ((calp util) :select (path-append))
+  :use-module (datetime)
   )
 
+(define (make-debug-item call-stack)
+  `(item
+    (title "RSS-FILTER ERROR")
+    (link "https://git.hornquist.se/rss-filter/")
+    (guid "RSS-FILTER-ERROR")
+    (description
+     ,(with-output-to-string
+        (lambda ()
+          (sxml->xml
+           `(div
+             (div (@ (style "background-color: pink"))
+                  "Something went wrong when filtering this item")
+             (pre
+              ,(with-output-to-string
+                 (lambda ()
+                   ((@ (system repl debug) terminal-width) #e1e10)
+                   (display-backtrace
+                    call-stack (current-output-port))))))))))
+    (author "rss-filter VERSION HERE")
+    (pubDate ,(datetime->string (current-datetime)))))
+
+
 (define ((handle-feed output-directory quiet?) feed)
   (define response
     (begin
@@ -32,8 +57,25 @@
                                  feed-title)))
 
 
-    (let ((output (filter-tree (feed-transformer feed)
-                               feed-content))
+    (let ((output
+           (let ((call-stack #f))
+             (catch
+               #t (lambda () (filter-tree (feed-transformer feed)
+                                     feed-content))
+               ;; error handler
+               (lambda _
+                 (filter-tree
+                  `((rss:channel . ,(match-lambda*
+                                  ((tag . (('@ args ...) body ...))
+                                   `(,tag (@ ,@args)
+                                          ,(make-debug-item call-stack)
+                                          ,@body))
+                                  ((tag body ...)
+                                   `(,tag ,(make-debug-item call-stack)
+                                          ,@body)))))
+                  feed-content))
+               ;; pre unwind hadler
+               (lambda _ (set! call-stack (make-stack #t))))))
           (filename (string-append
                      (path-append output-directory safe-title)
                      ".rss")))
-- 
cgit v1.2.3