diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-01-13 06:38:51 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-01-13 06:38:51 +0100 |
| commit | 953db5c6d3ffc07cd90bce25ddd266e9338f1d86 (patch) | |
| tree | a904d137ab9ba1b7197ad649d617f7328b15d5bc | |
| parent | Fix pre-install main. (diff) | |
| download | rss-filter-953db5c6d3ffc07cd90bce25ddd266e9338f1d86.tar.gz rss-filter-953db5c6d3ffc07cd90bce25ddd266e9338f1d86.tar.xz | |
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!
| -rw-r--r-- | module/rss-filter.scm | 46 |
1 files 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"))) |