suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

atom

Browse Source
This commit is contained in:
Jay McCarthy 2013-10-08 08:21:47 -06:00
parent 168d93e01a
commit e616cb0f8a
3 changed files with 91 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
pkgs/plt-services/meta/pkg-index/official/static.rkt
View File

@ -1,9 +1,12 @@
#lang racket/base #lang racket/base
(require web-server/http (require web-server/http
web-server/dispatch
racket/file racket/file
racket/match racket/match
json json
racket/date
net/url net/url
xml
racket/list racket/list
racket/path racket/path
racket/promise racket/promise
@ -43,33 +46,94 @@
(define pkg-list (define pkg-list
(map path->string (directory-list pkgs-path))) (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-index/basic
(λ () pkg-list) (λ () pkg-list)
(λ (pkg-name) (λ (pkg-name) (hash-ref pkg-ht pkg-name))))
(define ht (file->value (build-path pkgs-path pkg-name)))
(hash-set* ht (define (package-info pn)
'name pkg-name (hash-ref pkg-ht pn))
'tags (hash-ref ht 'tags empty)
'search-terms (define (format-time s)
(let* ([st (hasheq)] (if s
[st (for/fold ([st st]) (with-handlers ([exn:fail? (λ (x) "")])
([t (in-list (hash-ref ht 'tags empty))]) (parameterize ([date-display-format 'iso-8601])
(hash-set st (string->symbol t) #t))] (date->string (seconds->date s #f) #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 "")))]) (define (page/atom.xml req)
(hash-set st (string->symbol (format "author:~a" a)) #t))] (define ps
[st (if (empty? (hash-ref ht 'tags empty)) (sort (map package-info pkg-list)
(hash-set st ':no-tag: #t) >
st)] #:key (λ (i) (hash-ref i 'last-updated))))
[st (if (hash-ref ht 'checksum-error #f) (define top (hash-ref (first ps) 'last-updated))
(hash-set st ':error: #t) (define (atom-format-time t)
st)]) (format "~aZ" (format-time t)))
st) (response/xexpr
'authors (author->list (hash-ref ht 'author "")))))) #: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) (define (url->request u)
(make-request #"GET" (string->url u) empty (make-request #"GET" (string->url u) empty
@ -80,12 +144,13 @@
(make-directory* (path-only p)) (make-directory* (path-only p))
(with-output-to-file p (with-output-to-file p
#:exists 'replace #: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") (with-output-to-file (path-add-suffix p #".json")
#:exists 'replace #:exists 'replace
(λ () (write-json (convert-to-json (file->value p))))) (λ () (write-json (convert-to-json (file->value p)))))
(void)) (void))
(cache "/atom.xml" "atom.xml")
(cache "/pkgs" "pkgs") (cache "/pkgs" "pkgs")
(cache "/pkgs-all" "pkgs-all") (cache "/pkgs-all" "pkgs-all")
(for ([p (in-list pkg-list)]) (for ([p (in-list pkg-list)])

2
pkgs/plt-services/meta/pkg-index/official/static/index.html
View File

@ -30,7 +30,7 @@
Powered by <a href="http://racket-lang.org">Racket</a> and a Powered by <a href="http://racket-lang.org">Racket</a> and a
mess of ugly JS. Written mess of ugly JS. Written
by <a href="http://faculty.cs.byu.edu/~jay">Jay McCarthy</a>. 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> </div>
</body> </body>
</html> </html>

1
pkgs/plt-services/meta/pkg-index/official/static/index.js
View File

@ -1,6 +1,5 @@
// xxx display curation if allowed // xxx display curation if allowed
// xxx display conflicts as a tag // xxx display conflicts as a tag
// xxx rss
// xxx logout // xxx logout
// xxx what user am i // xxx what user am i
// xxx upload // xxx upload