atom
This commit is contained in:
Jay McCarthy
parent
168d93e01a
commit
e616cb0f8a
|
|
@ -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 "<![CDATA[~a]]>"
|
||||
"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 "<![CDATA[~a]]>" p)))
|
||||
(link ([href ,this-url]))
|
||||
(updated ,lu)
|
||||
(author (name ,n) (email ,a))
|
||||
(id ,this-url)
|
||||
(content
|
||||
([type "html"])
|
||||
,(cdata #f #f
|
||||
(format "<![CDATA[~a]]>"
|
||||
(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
|
||||
(λ () (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)])
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
Powered by <a href="http://racket-lang.org">Racket</a> and a
|
||||
mess of ugly JS. Written
|
||||
by <a href="http://faculty.cs.byu.edu/~jay">Jay McCarthy</a>.
|
||||
<a href="/rss">RSS</a> feed available.
|
||||
<a href="/atom.xml">Atom</a> feed available.
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user