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

Work on dates

This commit is contained in:
Lassi Kortela 2021-08-21 17:23:13 +03:00
parent 20dba0c3d3
commit 11b20cb003
2 changed files with 42 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
planet-scheme.scm
View File

@ -42,7 +42,7 @@
,@(map
(lambda (entries)
`(section
(h2 ,(entry-us-english-date (first entries)))
(h2 ,(entry-english-year-and-month (first entries)))
,@(map (lambda (entry)
`(article
(h3 ,(entry-title entry))

62
planet.sld
View File

@ -8,6 +8,7 @@
entry-content-xhtml
entry-iso-date
entry-us-english-date
entry-english-year-and-month
planet-refresh-feed
planet-all-entries-ever
planet-n-newest-entries
@ -81,6 +82,21 @@
(define (path-append . paths)
(string-join paths "/"))
(define english-month-names
(vector
"January"
"February"
"March"
"April"
"May"
"June"
"July"
"August"
"September"
"October"
"November"
"December"))
;;;
(define-record-type feed
@ -112,34 +128,33 @@
(define (entry-content-xhtml entry)
(content-xhtml (entry-content entry)))
(define (entry-iso-date entry)
(define (entry-rfc3339-digits n entry)
(let ((rfc3339 (entry-updated entry)))
(if (and rfc3339 (>= (string-length rfc3339) 10))
(substring rfc3339 0 10)
(if (and rfc3339 (>= (string-length rfc3339) n))
(substring rfc3339 0 n)
(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"))
(define (entry-iso-date entry) (entry-rfc3339-digits 10 entry))
(define (entry-iso-month entry) (entry-rfc3339-digits 7 entry))
(define (entry-y-m-d-integers entry)
(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))))
(day (string->number (substring yyyy-mm-dd 8 10))))
(values year month day)))
(define (entry-us-english-date entry)
(let-values (((year month day) (entry-y-m-d-integers entry)))
(let ((month-name (vector-ref english-month-names (- month 1))))
(string-append
(number->string day) " " month-name " " (number->string year)))))
(define (entry-english-year-and-month entry)
(let-values (((year month _) (entry-y-m-d-integers entry)))
(let ((month-name (vector-ref english-month-names (- month 1))))
(string-append month-name " " (number->string year)))))
(define (entry-iso-date<? entry1 entry2)
(string<? (entry-iso-date entry1)
@ -159,6 +174,9 @@
(define (planet-group-entries-by-date entries)
(group-by entry-iso-date entries))
(define (planet-group-entries-by-month entries)
(group-by entry-iso-month entries))
(define (write-html-file filename sxml)
(supersede-text-file
filename (lambda ()