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

Support curation/ring-change

Browse Source
This commit is contained in:
Tony Garnock-Jones 2015-10-02 20:46:38 -04:00
parent a06651831e
commit 8a024e26e1
2 changed files with 46 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/site.rkt
View File

@ -76,6 +76,7 @@
[("package" (string-arg)) package-page]
[("package" (string-arg) "edit") edit-package-page]
[("update-my-packages") update-my-packages-page]
[("update-package-ring" (string-arg) (integer-arg)) #:method "post" update-package-ring-page]
[("not-found") not-found-page]
[("create") edit-package-page]
[("login") login-page]
@ -680,6 +681,21 @@
#f]))
deps))
(define (clamp-ring r)
(max 0 (min 2 r)))
(define (ring-change-link pkg proposed-new-ring link-content)
(define new-ring (clamp-ring proposed-new-ring))
`(form ((role "form")
(class "ring-change-link")
(method "post")
(action ,(named-url update-package-ring-page (~a (package-name pkg)) new-ring)))
(button ((class "btn btn-danger btn-xs")
,@(maybe-splice
(= new-ring (package-ring pkg))
`(disabled "disabled"))
(type "submit")) ,link-content)))
(define (not-found-page request [package-name-str #f])
(authentication-wrap
#:request request
@ -809,7 +825,14 @@
(tr (th "Last updated")
(td ,(utc->string (package-last-updated pkg))))
(tr (th "Ring")
(td ,(~a (or (package-ring pkg) "N/A"))))
(td ,(~a (or (package-ring pkg) "N/A"))
,@(maybe-splice
(and (package-ring pkg)
(current-session)
(session-curator? (current-session)))
" "
(ring-change-link pkg (- (package-ring pkg) 1) 'blacktriangledown)
(ring-change-link pkg (+ (package-ring pkg) 1) 'blacktriangle))))
(tr (th "Conflicts")
(td ,(package-links (package-conflicts pkg))))
(tr (th "Dependencies")
@ -1269,6 +1292,22 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-package-ring-page request package-name-str proposed-new-ring)
(define new-ring (clamp-ring proposed-new-ring))
(authentication-wrap/require-login
#:request request
(when (session-curator? (current-session))
(when (jsonp-rpc! "/jsonp/package/curate" `((pkg . ,package-name-str)
(ring . ,(number->string new-ring))))
(define old-pkg (package-detail (string->symbol package-name-str)))
(let* ((new-pkg (hash-set old-pkg 'ring new-ring))
(completion-ch (make-channel)))
(replace-package! completion-ch old-pkg new-pkg)
(channel-get completion-ch))))
(bootstrap-redirect (view-package-url package-name-str))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (search-page request)
(parameterize ((bootstrap-active-navigation nav-search)
(bootstrap-page-scripts '("/searchbox.js")))

7
static/style.css
View File

@ -138,4 +138,9 @@ th.headerSortDown::after { content: " ▲"; }
border-radius: 10px;
}
.registration-step h1 { margin: 0.5em; }
.registration-step p { font-size: 140%; }
.registration-step p { font-size: 140%; }
.ring-change-link {
display: inline-block;
padding: 0 0.15em;
}