◊(Local Yarn Code "rss-feed.rkt at [dc2a4bd0]")

File rss-feed.rkt artifact 1e1d5b0c part of check-in dc2a4bd0


#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.

;; Generates an Atom feed from the SQLite cache

(require txexpr
         deta
         racket/match
         racket/file
         racket/date
         racket/string
         racket/sequence
         "dust.rkt"
         "cache.rkt")

(provide main)

(define feed-author default-authorname)
(define feed-author-email "joel@jdueck.net")
(define feed-title "The Local Yarn (Beta)")
(define feed-site-url "https://thelocalyarn.com")
(define feed-item-limit 50)

(define (as-cdata string)
  (cdata #f #f (format "<![CDATA[~a]]>" string))) ; cdata from xml package via txexpr

(define (email-encode str)
  (map char->integer (string->list str)))

;; Atom feeds require dates to be in RFC 3339 format
;; Our published/updated dates only give year-month-day. No need to bother about time zones or DST.
;; So, arbitrarily, everything happens at a quarter of noon UTC.
(define (ymd->rfc3339 datestr)
  (format "~aT11:45:00Z" datestr))

;; For the feed "updated" value, we do want a complete timestamp.
(define (current-rfc3339)
  ;; #f argument to seconds->date forces a UTC timestamp
  (define now (seconds->date (* 0.001 (current-inexact-milliseconds)) #f))
  (define timestamp
    (parameterize [(date-display-format 'iso-8601)]
      (date->string now #t)))
  (string-append timestamp "Z"))

;; Get the data out of the SQLite cache as vectors
(define (fetch-rows)
  (sequence->list
   (in-entities (cache-conn)
                (articles+notes 'content #:series #f #:limit feed-item-limit))))

(define (listing->rss-item lst)
  (match-define (listing _ path title author published updated html) lst)
  (define entry-url (string-append feed-site-url web-root path))
  (define updated-ts (if (non-empty-string? updated) updated published))
  
  `(entry (author (name ,author))
          (published    ,(ymd->rfc3339 published))
          (updated      ,(ymd->rfc3339 updated-ts))
          (title        ,title)
          (link [[rel "alternate"] [href ,entry-url]])
          (id           ,entry-url)
          (summary [[type "html"]]
                   ,(as-cdata html))))

(define (rss-feed)
  (define feed-xpr
    `(feed [[xml:lang "en-us"] [xmlns "http://www.w3.org/2005/Atom"]]
           (title ,feed-title)
           (link [[rel "self"] [href ,(string-append feed-site-url web-root "feed.xml")]])
           (generator [[uri "http://pollenpub.com/"]] "Pollen")
           (id ,(string-append feed-site-url web-root))
           (updated ,(current-rfc3339))
           (author
            (name ,feed-author)
            (email ,@(email-encode feed-author-email)))
           ,@(map listing->rss-item (fetch-rows))))
  (string-append "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
                 (xexpr->string feed-xpr)))

(define (main)
  (display-to-file (rss-feed) "feed.xml" #:mode 'text #:exists 'replace))