Héllo,
I share with you this small *atom* feed reader which works from command
line. Create a ~/.prime.txt file with the address of atom files you want
to follow and then run the script.
The problem I have is that it fails on wingolog and others but I'm
accepting patches ;)
--
Amirouche ~ amz3 ~ http://www.hyperdev.fr
(use-modules (srfi srfi-9))
(use-modules (srfi srfi-19))
(use-modules (srfi srfi-26))
(use-modules (ice-9 match))
(use-modules (ice-9 rdelim))
(use-modules (ice-9 receive))
(use-modules (sxml xpath))
(use-modules (sxml simple))
(use-modules (srfi srfi-1))
(use-modules (web client))
;; XXX: this is required for some reason
(setlocale LC_ALL "")
;;; srfi-999
(define-syntax define-record-type*
(lambda (x)
(define (%id-name name) (string->symbol (string-drop
(string-drop-right
(symbol->string name) 1) 1)))
(define (id-name ctx name)
(datum->syntax ctx (%id-name (syntax->datum name))))
(define (id-append ctx . syms)
(datum->syntax ctx (apply symbol-append (map syntax->datum syms))))
(syntax-case x ()
((_ rname field ...)
(and (identifier? #'rname) (and-map identifier? #'(field ...)))
(with-syntax ((cons (id-append #'rname #'make- (id-name #'rname
#'rname)))
(pred (id-append #'rname (id-name #'rname #'rname) #'?))
((getter ...) (map (lambda (f)
(id-append f (id-name #'rname
#'rname) #'- f))
#'(field ...))))
#'(define-record-type rname
(cons field ...)
pred
(field getter)
...))))))
;;; sxml procedures
(define (file->sxml filename)
(cdr (xml->sxml (with-input-from-file filename
(lambda ()
(read-string))))))
(define (url-fetch url)
(pk url)
(receive (_ body) (http-get url) body))
;; helpers to turn atom into scheme
(define (sxml->date sxml)
;; FIXME: add support for TZ
(let* ((timestamp (car ((sxpath '(http://www.w3.org/2005/Atom:updated
*text*)) sxml)))
(length (string-length "2015-08-13T00:24:00"))
(date (string->date (string-take timestamp length)
"~Y-~m-~dT~H:~M:~S")))
;; date))
timestamp))
(define (sxml->feed sxml)
(map (lambda (spec) (cons (car spec) ((cadr spec) sxml)))
`((title ,(sxpath '(http://www.w3.org/2005/Atom:id *text*)))
(updated-at ,sxml->date)
(author ,(sxpath '(http://www.w3.org/2005/Atom:author
http://www.w3.org/2005/Atom:name *text*)))
;; XXX: can't retrieve a url node because the attribute axis
`equal?``match all the children
;; instead of testing the existance of the provided pair.
;; XXX: the following should match the "href" attribute value of the
"alternate" link node
;; (url ,(sxpath '(http://www.w3.org/2005/Atom:link (@ (equal? (rel
"alternate"))) @ href *text*)))
(entries ,(sxpath '(http://www.w3.org/2005/Atom:entry))))))
;; borrowed from guix
(define* (string-replace-substring str substr replacement
#:optional
(start 0)
(end (string-length str)))
"Replace all occurrences of SUBSTR in the START--END range
of STR by REPLACEMENT."
(match (string-length substr)
(0
(error "string-replace-substring: empty substring"))
(substr-length
(let loop ((start start)
(pieces (list (substring str 0 start))))
(match (string-contains str substr start end)
(#f
(string-concatenate-reverse
(cons (substring str start) pieces)))
(index
(loop (+ index substr-length)
(cons* replacement
(substring str start index)
pieces))))))))
;; borrowed from haunt
(define (unescape str)
(define *escape-map* '(("<". "<")
(">" . ">")
("&" . "&")
(""" . "\"")))
(fold (lambda (escape str)
(string-replace-substring str (car escape) (cdr escape)))
str
*escape-map*))
(define (sxml->summary sxml)
(define summary->string
(compose cdr xml->sxml unescape car (sxpath
'(http://www.w3.org/2005/Atom:summary *text*))))
(catch #true
(lambda () (summary->string sxml))
(lambda (key . args) "")))
(define (sxml->entry sxml)
(map (lambda (spec) (cons (car spec) ((cdr spec) sxml)))
`((title . ,(compose car (sxpath '(http://www.w3.org/2005/Atom:title
*text*))))
(url . ,(compose car (sxpath '(http://www.w3.org/2005/Atom:link @ href
*text*))))
;; (summary . ,sxml->summary)
(updated-at . ,sxml->date)
;; (uid . ,(compose car (sxpath '(http://www.w3.org/2005/Atom:id
*text*))))
)))
(define url->feed (compose sxml->feed cdr xml->sxml url-fetch))
(define (url->entries url)
(map sxml->entry (assoc-ref (url->feed url) 'entries)))
(define (feeds)
(let ((prime.txt (string-join (list (getenv "HOME") ".prime.txt") "/")))
(call-with-input-file prime.txt
(lambda (port)
(let loop ((line (read-line port))
(out '()))
(if (eof-object? line)
out
(loop (read-line port) (cons line out))))))))
(define (sort-entries a b)
(string>? (assoc-ref a 'updated-at) (assoc-ref b 'updated-at)))
(define (format-entry entry)
(format #t "* ~a\n** ~a\n** ~a\n\n"
(assoc-ref entry 'title)
(assoc-ref entry 'url)
(assoc-ref entry 'updated-at)))
(map format-entry (sort (append-map url->entries (feeds)) sort-entries))
;; .prime.txt content
;;
;; http://savannah.gnu.org/news/atom.php?group=guix
;; http://savannah.gnu.org/news/atom.php?group=guile
;; http://dustycloud.org/blog/index.xml
