89 lines
2.4 KiB
Scheme
89 lines
2.4 KiB
Scheme
;;
|
|
;; Copyright © 2021 kitzman <kitzman @ disroot . org>
|
|
;;
|
|
|
|
(define-module (lieferhund proto)
|
|
#:use-module (lieferhund proto rss)
|
|
#:use-module (lieferhund proto atom)
|
|
#:use-module (lieferhund config)
|
|
#:use-module (lieferhund db)
|
|
#:use-module (lieferhund util)
|
|
#:use-module (srfi srfi-9)
|
|
#:use-module (ice-9 match)
|
|
|
|
#:export (<feed-entry>
|
|
make-feed-entry
|
|
entry-title
|
|
entry-description
|
|
entry-link
|
|
entry-date
|
|
|
|
retrieve-feed-entries))
|
|
|
|
;;
|
|
;; Feed entry
|
|
;;
|
|
|
|
(define-record-type <feed-entry>
|
|
(make-feed-entry title description link date)
|
|
news-feed-entry?
|
|
(title entry-title)
|
|
(description entry-description)
|
|
(link entry-link)
|
|
(date entry-date))
|
|
|
|
;;
|
|
;; Retrieve feed entries depending on type
|
|
;;
|
|
|
|
(define proto-map
|
|
`((rss . (,(lambda (config-entry)
|
|
(request-rss-feed (config-entry-url config-entry)))
|
|
,(lambda (response-items)
|
|
(map
|
|
(match-lambda
|
|
((title description link pub-date)
|
|
(begin
|
|
(make-feed-entry
|
|
title description link pub-date))))
|
|
(parse-rss-feed-response response-items)))))
|
|
(atom . (,(lambda (config-entry)
|
|
(request-atom-feed (config-entry-url config-entry)))
|
|
,(lambda (response-items)
|
|
(map
|
|
(match-lambda
|
|
((title description link pub-date)
|
|
(begin
|
|
(make-feed-entry
|
|
title description link pub-date))))
|
|
(parse-atom-feed-response response-items)))))))
|
|
|
|
(define (proto-map-retrieval-fn proto)
|
|
(and=> (assoc-ref proto-map proto) car))
|
|
|
|
(define (proto-map-parse-fn proto)
|
|
(and=> (assoc-ref proto-map proto) cadr))
|
|
|
|
(define (retrieve-feed-entries config-entry conf db)
|
|
(format #t "processing item \"~a\" (~a)\n"
|
|
(config-entry-name config-entry)
|
|
(config-entry-url config-entry))
|
|
(let* ((entry-type (config-entry-type config-entry))
|
|
(retrieval-fn (proto-map-retrieval-fn entry-type))
|
|
(parse-fn (proto-map-parse-fn entry-type))
|
|
(retrieved-data (and<= retrieval-fn config-entry))
|
|
(parsed-entries (and<=> parse-fn retrieved-data))
|
|
(new-items (if (equal? retrieved-data #f)
|
|
'()
|
|
(database-insert-entries!
|
|
db conf config-entry parsed-entries))))
|
|
(if (or (eq? retrieval-fn #f) (eq? parse-fn #f))
|
|
(begin
|
|
(format #t "unable to find the configured feed type!\n")
|
|
#f)
|
|
(begin
|
|
(if (eq? retrieved-data #f)
|
|
(format #t "failed to retrieve data!\n")
|
|
(format #t "new items: ~a\n" (length new-items)))
|
|
`(,config-entry ,new-items)))))
|