lassik
/
another-planet
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add XHTML and US English dates

This commit is contained in:
Lassi Kortela 2021-08-21 17:10:34 +03:00
parent d5301833eb
commit 836a7030e8
2 changed files with 44 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
planet-scheme.scm
View File

@ -41,10 +41,15 @@
(h1 ,title) (h1 ,title)
,@(map ,@(map
(lambda (entries) (lambda (entries)
(let ((date (entry-iso-date (first entries))))
`(section `(section
(h2 ,date) (h2 ,(entry-us-english-date (first entries)))
,@(map entry->html entries)))) ,@(map (lambda (entry)
`(article
(h3 ,(entry-title entry))
,(or (entry-content-xhtml entry)
`(div))
(p "by " ,(entry-author entry))))
entries)))
(planet-group-entries-by-date (planet-group-entries-by-date
(planet-n-newest-entries 10 feeds cache-directory)))))) (planet-n-newest-entries 10 feeds cache-directory))))))

42
planet.sld
View File

@ -3,9 +3,11 @@
feed-id feed-id
feed-title feed-title
feed-url feed-url
entry-author
entry-title entry-title
entry-content-xhtml
entry-iso-date entry-iso-date
entry->html entry-us-english-date
planet-refresh-feed planet-refresh-feed
planet-all-entries-ever planet-all-entries-ever
planet-n-newest-entries planet-n-newest-entries
@ -29,10 +31,13 @@
(only (traversal) (only (traversal)
group-by) group-by)
(only (atom) (only (atom)
read-atom-feed content-xhtml
feed-entries entry-author
entry-content
entry-title
entry-updated entry-updated
entry-title)))) feed-entries
read-atom-feed))))
(begin (begin
(define (take-at-most list n) (define (take-at-most list n)
@ -104,19 +109,42 @@
(let ((cache-file (feed-cache-file feed cache-directory))) (let ((cache-file (feed-cache-file feed cache-directory)))
(call-with-port (open-binary-input-file cache-file) read-atom-feed))) (call-with-port (open-binary-input-file cache-file) read-atom-feed)))
(define (entry-content-xhtml entry)
(content-xhtml (entry-content entry)))
(define (entry-iso-date entry) (define (entry-iso-date entry)
(let ((rfc3339 (entry-updated entry))) (let ((rfc3339 (entry-updated entry)))
(if (and rfc3339 (>= (string-length rfc3339) 10)) (if (and rfc3339 (>= (string-length rfc3339) 10))
(substring rfc3339 0 10) (substring rfc3339 0 10)
(error "No date")))) (error "No date"))))
(define (entry-us-english-date entry)
(define month-names
(vector
"January"
"February"
"March"
"April"
"May"
"June"
"July"
"August"
"September"
"October"
"November"
"December"))
(let* ((yyyy-mm-dd (entry-iso-date entry))
(year (string->number (substring yyyy-mm-dd 0 4)))
(month (string->number (substring yyyy-mm-dd 5 7)))
(month-name (vector-ref month-names (- month 1)))
(day-of-month (string->number (substring yyyy-mm-dd 8 10))))
(string-append (number->string day-of-month) " "
month-name " " (number->string year))))
(define (entry-iso-date<? entry1 entry2) (define (entry-iso-date<? entry1 entry2)
(string<? (entry-iso-date entry1) (string<? (entry-iso-date entry1)
(entry-iso-date entry2))) (entry-iso-date entry2)))
(define (entry->html entry)
`(h3 ,(entry-title entry)))
(define (planet-all-entries-ever feeds cache-directory) (define (planet-all-entries-ever feeds cache-directory)
(let ((entries (append-map feed-entries (let ((entries (append-map feed-entries
(map (lambda (feed) (map (lambda (feed)