diff --git a/pkgs/plt-services/meta/pkg-index/official/static.rkt b/pkgs/plt-services/meta/pkg-index/official/static.rkt
index a1fe3ce2c6..fc728b3291 100644
--- a/pkgs/plt-services/meta/pkg-index/official/static.rkt
+++ b/pkgs/plt-services/meta/pkg-index/official/static.rkt
@@ -1,9 +1,12 @@
#lang racket/base
(require web-server/http
+ web-server/dispatch
racket/file
racket/match
json
+ racket/date
net/url
+ xml
racket/list
racket/path
racket/promise
@@ -43,33 +46,94 @@
(define pkg-list
(map path->string (directory-list pkgs-path)))
+ (define pkg-ht
+ (for/hash ([pkg-name (in-list pkg-list)])
+ (define ht (file->value (build-path pkgs-path pkg-name)))
- (define dispatch
+ (values pkg-name
+ (hash-set* ht
+ 'name pkg-name
+ 'tags (hash-ref ht 'tags empty)
+ 'search-terms
+ (let* ([st (hasheq)]
+ [st (for/fold ([st st])
+ ([t (in-list (hash-ref ht 'tags empty))])
+ (hash-set st (string->symbol t) #t))]
+ [st (hash-set st (string->symbol (format "ring:~a" (hash-ref ht 'ring 2))) #t)]
+ [st (for/fold ([st st])
+ ([a (in-list (author->list (hash-ref ht 'author "")))])
+ (hash-set st (string->symbol (format "author:~a" a)) #t))]
+ [st (if (empty? (hash-ref ht 'tags empty))
+ (hash-set st ':no-tag: #t)
+ st)]
+ [st (if (hash-ref ht 'checksum-error #f)
+ (hash-set st ':error: #t)
+ st)])
+ st)
+ 'authors (author->list (hash-ref ht 'author ""))))))
+
+ (define basic-dispatch
(pkg-index/basic
(λ () pkg-list)
- (λ (pkg-name)
- (define ht (file->value (build-path pkgs-path pkg-name)))
+ (λ (pkg-name) (hash-ref pkg-ht pkg-name))))
- (hash-set* ht
- 'name pkg-name
- 'tags (hash-ref ht 'tags empty)
- 'search-terms
- (let* ([st (hasheq)]
- [st (for/fold ([st st])
- ([t (in-list (hash-ref ht 'tags empty))])
- (hash-set st (string->symbol t) #t))]
- [st (hash-set st (string->symbol (format "ring:~a" (hash-ref ht 'ring 2))) #t)]
- [st (for/fold ([st st])
- ([a (in-list (author->list (hash-ref ht 'author "")))])
- (hash-set st (string->symbol (format "author:~a" a)) #t))]
- [st (if (empty? (hash-ref ht 'tags empty))
- (hash-set st ':no-tag: #t)
- st)]
- [st (if (hash-ref ht 'checksum-error #f)
- (hash-set st ':error: #t)
- st)])
- st)
- 'authors (author->list (hash-ref ht 'author ""))))))
+ (define (package-info pn)
+ (hash-ref pkg-ht pn))
+
+ (define (format-time s)
+ (if s
+ (with-handlers ([exn:fail? (λ (x) "")])
+ (parameterize ([date-display-format 'iso-8601])
+ (date->string (seconds->date s #f) #t)))
+ ""))
+
+ (define (page/atom.xml req)
+ (define ps
+ (sort (map package-info pkg-list)
+ >
+ #:key (λ (i) (hash-ref i 'last-updated))))
+ (define top (hash-ref (first ps) 'last-updated))
+ (define (atom-format-time t)
+ (format "~aZ" (format-time t)))
+ (response/xexpr
+ #:mime-type #"application/atom+xml"
+ `(feed
+ ([xmlns "http://www.w3.org/2005/Atom"])
+ (title ,(cdata #f #f (format ""
+ "Racket Package Updates")))
+ (link ([href "https://pkg.racket-lang.org/rss"]
+ [rel "self"]))
+ (link ([href "https://pkg.racket-lang.org/"]))
+ (updated ,(atom-format-time top))
+ (id "https://pkg.racket-lang.org/")
+ ,@(for/list ([i (in-list ps)])
+ (define p (hash-ref i 'name))
+ (define this-url
+ (format "http://pkg.racket-lang.org/#[~a]"
+ p))
+ (define lu (atom-format-time (hash-ref i 'last-updated)))
+ (define a (first (author->list (hash-ref i 'author))))
+ (match-define (regexp #rx"^([^@]+)" (list _ n)) a)
+ `(entry
+ (title ([type "html"])
+ ,(cdata #f #f (format "" p)))
+ (link ([href ,this-url]))
+ (updated ,lu)
+ (author (name ,n) (email ,a))
+ (id ,this-url)
+ (content
+ ([type "html"])
+ ,(cdata #f #f
+ (format ""
+ (xexpr->string
+ `(p
+ ,(format "~a package updated on ~a."
+ p lu)))))))))))
+
+ (define-values (main-dispatch main-url)
+ (dispatch-rules
+ [("atom.xml") page/atom.xml]
+ [else basic-dispatch]))
(define (url->request u)
(make-request #"GET" (string->url u) empty
@@ -80,12 +144,13 @@
(make-directory* (path-only p))
(with-output-to-file p
#:exists 'replace
- (λ () ((response-output (dispatch (url->request url))) (current-output-port))))
+ (λ () ((response-output (main-dispatch (url->request url))) (current-output-port))))
(with-output-to-file (path-add-suffix p #".json")
- #:exists 'replace
+ #:exists 'replace
(λ () (write-json (convert-to-json (file->value p)))))
(void))
+ (cache "/atom.xml" "atom.xml")
(cache "/pkgs" "pkgs")
(cache "/pkgs-all" "pkgs-all")
(for ([p (in-list pkg-list)])
diff --git a/pkgs/plt-services/meta/pkg-index/official/static/index.html b/pkgs/plt-services/meta/pkg-index/official/static/index.html
index 7eb0f8ce7f..d84b3187b2 100644
--- a/pkgs/plt-services/meta/pkg-index/official/static/index.html
+++ b/pkgs/plt-services/meta/pkg-index/official/static/index.html
@@ -30,7 +30,7 @@
Powered by Racket and a
mess of ugly JS. Written
by Jay McCarthy.
- RSS feed available.
+ Atom feed available.