From e616cb0f8ad37e075ace36e2e2e1cbda87cf982f Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 8 Oct 2013 08:21:47 -0600 Subject: [PATCH] atom --- .../meta/pkg-index/official/static.rkt | 115 ++++++++++++++---- .../meta/pkg-index/official/static/index.html | 2 +- .../meta/pkg-index/official/static/index.js | 1 - 3 files changed, 91 insertions(+), 27 deletions(-) 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. diff --git a/pkgs/plt-services/meta/pkg-index/official/static/index.js b/pkgs/plt-services/meta/pkg-index/official/static/index.js index 85b07f7679..9fdb76b54a 100644 --- a/pkgs/plt-services/meta/pkg-index/official/static/index.js +++ b/pkgs/plt-services/meta/pkg-index/official/static/index.js @@ -1,6 +1,5 @@ // xxx display curation if allowed // xxx display conflicts as a tag -// xxx rss // xxx logout // xxx what user am i // xxx upload