From f6032faa669b3bde228f655bd66c30a30e418ca2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 22 Aug 2021 16:09:36 +0200 Subject: Initial commit. --- main.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100755 main.scm (limited to 'main.scm') diff --git a/main.scm b/main.scm new file mode 100755 index 0000000..d0459b2 --- /dev/null +++ b/main.scm @@ -0,0 +1,58 @@ +#!/usr/bin/guile \ +-e main -s +!# + +(use-modules + (web client) + (web response) + (sxml simple) + (sxml xpath) + (sxml transform) + (ice-9 regex) + ) + + + +(define transformer + `((rss:item + . ,(lambda (key . children) + (define tag (cons key children)) + (call-with-values (lambda () (apply values ((sxpath '(rss:title *text*)) tag))) + (case-lambda (() tag) + ((title . _) + (if (string-match "^\\[\\$\\]" title) + '() tag)))))))) + +(define (parse-rss port) + (xml->sxml port + #:namespaces + '((rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#") + (dc . "http://purl.org/dc/elements/1.1/") + (syn . "http://purl.org/rss/1.0/modules/syndication/") + (rss . "http://purl.org/rss/1.0/"))) ) + +(define (filter-tree transformers tree) + (pre-post-order + tree + `(,@transformer + (*text* . ,(lambda (_ x . xs) x)) + (*default* . ,(lambda (item . children) + (cons item children))))) ) + +(define (main args) + + (define response + (http-get "https://lwn.net/headlines/Features" + #:streaming? #t)) + + (unless (= 200 (response-code response)) + (format (current-error-port) "HTTP error ~a" + (response-code response)) + (exit 1)) + + (with-output-to-file "lwn-unlocked-features.xml" + (lambda () + (sxml->xml + (filter-tree + transformer + (parse-rss (response-body-port response))))))) -- cgit v1.2.3