diff --git a/src/site.rkt b/src/site.rkt index 403e125..38c83a9 100644 --- a/src/site.rkt +++ b/src/site.rkt @@ -96,6 +96,7 @@ [("json" "formal-tags") json-formal-tags] [("pkgs-all.json") pkgs-all-json] [("ping") ping-page] + [("bulk-operation") #:method "post" bulk-operation-page] )) (define (on-continuation-expiry request) @@ -244,17 +245,23 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define ((generic-input type) name [initial-value ""] #:placeholder [placeholder #f]) - `(input ((class "form-control") +(define ((generic-input type #:extra-classes [extra-classes1 '()]) + name + [initial-value ""] + #:id [id name] + #:extra-classes [extra-classes2 '()] + #:placeholder [placeholder #f]) + `(input ((class ,(string-join (cons "form-control" (append extra-classes1 extra-classes2)) " ")) (type ,type) (name ,name) - (id ,name) + ,@(maybe-splice id `(id ,id)) ,@(maybe-splice placeholder `(placeholder ,placeholder)) (value ,initial-value)))) (define email-input (generic-input "email")) (define password-input (generic-input "password")) (define text-input (generic-input "text")) +(define checkbox-input (generic-input "checkbox")) (define (label for . content) `(label ((class "control-label") ,@(maybe-splice for `(for ,for))) @@ -601,25 +608,50 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (package-summary-table package-names) + (define bulk-operations-enabled? (current-user-curator?)) + (define column-count (+ 4 (if bulk-operations-enabled? 1 0))) (define-values (pkg-rows num-todos) - (build-pkg-rows/num-todos package-names)) - `(table - ((class "packages sortable") (data-todokey ,(number->string num-todos))) - (thead - (tr - (th 'nbsp) - (th "Package") - (th "Description") - (th "Build") - (th ((style "display: none")) 'nbsp))) ;; todokey - (tbody - ,@(maybe-splice (null? package-names) - `(tr (td ((colspan "4")) - (div ((class "alert alert-info")) - "No packages found.")))) - ,@pkg-rows))) + (build-pkg-rows/num-todos bulk-operations-enabled? package-names)) + `(form ((role "form") + (action ,(named-url bulk-operation-page)) + (method "post")) + (table + ((class "packages sortable") (data-todokey ,(number->string num-todos))) + (thead + ,@(maybe-splice + bulk-operations-enabled? + `(tr + (td ((colspan ,(~a column-count))) + (div ((class "input-group")) + (select ((class "form-control") (id "bulk-action") (name "bulk-action")) + (option ((value "")) "--- Select a bulk action to perform ---") + (option ((value "make-ring-0")) "Set selected packages to ring 0") + (option ((value "make-ring-1")) "Set selected packages to ring 1") + (option ((value "make-ring-2")) "Set selected packages to ring 2") + ) + (span ((class "input-group-btn")) + (button ((class "btn btn-default") (type "submit")) + "Go!"))) + (div ((class "input-group")) + (button ((class "btn") + (type "button") + (onclick "toggleBulkOperationSelections()")) + "Select all/none"))))) + (tr + (th 'nbsp) + ,@(maybe-splice bulk-operations-enabled? `(th 'nbsp)) + (th "Package") + (th "Description") + (th "Build") + (th ((style "display: none")) 'nbsp))) ;; todokey + (tbody + ,@(maybe-splice (null? package-names) + `(tr (td ((colspan ,(~a column-count))) + (div ((class "alert alert-info")) + "No packages found.")))) + ,@pkg-rows)))) -(define (build-pkg-rows/num-todos package-names) +(define (build-pkg-rows/num-todos bulk-operations-enabled? package-names) ;; Builds the list of rows in the package table as an x-exp. ;; Also returns the total number of non-zero todo keys, ;; representing packages with outstanding build errors or @@ -653,6 +685,13 @@ (label-p (if (< todokey 5) "label-warning" "label-danger") "Todo"))) + ,@(maybe-splice + bulk-operations-enabled? + `(td (p "Ring " ,(~a (package-ring pkg))) + ,(checkbox-input "selected-packages" + (package-name pkg) + #:id #f + #:extra-classes `("selected-packages")))) (td (h2 ,(package-link (package-name pkg))) ,(authors-list (package-authors pkg))) (td (p ,(if (string=? "" (package-description pkg)) @@ -718,7 +757,7 @@ (parameterize ((bootstrap-active-navigation nav-index) (bootstrap-page-scripts (list (static-resource-url "/searchbox.js") (static-resource-url "/index.js") - (static-resource-url "/todos.js")))) + (static-resource-url "/package-list.js")))) (define package-name-list (package-search "" '((main-distribution #f) (main-tests #f) (deprecated #f)))) @@ -804,10 +843,17 @@ `(ul (li (a ((href ,(main-page-url))) "Return to the package index")))))) +(define (current-user-superuser?) + (and (current-session) + (session-superuser? (current-session)))) + +(define (current-user-curator?) + (and (current-session) + (session-curator? (current-session)))) + (define (current-user-may-edit? pkg) (or (member (current-email) (package-authors pkg)) - (and (current-session) - (session-superuser? (current-session))))) + (current-user-superuser?))) (define (package-page request package-name-str) (define package-name (string->symbol package-name-str)) @@ -935,9 +981,7 @@ (tr (th "Ring") (td ,(~a (or (package-ring pkg) "N/A")) ,@(maybe-splice - (and (package-ring pkg) - (current-session) - (session-curator? (current-session))) + (and (package-ring pkg) (current-user-curator?)) " " (ring-change-link pkg (- (package-ring pkg) 1) 'blacktriangledown) (ring-change-link pkg (+ (package-ring pkg) 1) 'blacktriangle)))) @@ -1400,27 +1444,35 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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 (simple-json-rpc! backend-baseurl - "/api/package/curate" - (hash 'pkg package-name-str - 'ring 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)))) + (update-package-rings! (list package-name-str) proposed-new-ring) (bootstrap-redirect (view-package-url package-name-str)))) +(define (update-package-rings! package-name-strings proposed-new-ring) + (if (not (current-user-curator?)) + #f + (let ((new-ring (clamp-ring proposed-new-ring))) + (if (not (simple-json-rpc! backend-baseurl + "/api/package/curate" + (hash 'package-names package-name-strings + 'ring new-ring))) + #f + (begin + (for [(package-name-str (in-list package-name-strings))] + (define old-pkg (package-detail (string->symbol package-name-str))) + (define new-pkg (hash-set old-pkg 'ring new-ring)) + (let ((completion-ch (make-channel))) + (replace-package! completion-ch old-pkg new-pkg) + (channel-get completion-ch))) + #t))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (search-page request) (parameterize ((bootstrap-active-navigation nav-search) (bootstrap-page-scripts (list (static-resource-url "/searchbox.js") - (static-resource-url "/todos.js")))) + (static-resource-url "/package-list.js")))) (authentication-wrap #:request request (define-form-bindings request ([search-text q ""] @@ -1480,6 +1532,41 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (bulk-operation-page request) + (authentication-wrap/require-login + #:request request + (cond + [(not (or (current-user-curator?) (current-user-superuser?))) + (bootstrap-redirect (main-page-url))] + [else + (define bindings (request-bindings request)) + (define action (extract-binding/single 'bulk-action bindings)) + (define package-names (extract-bindings 'selected-packages bindings)) + (cond + [(equal? action "") + (bootstrap-response "No action selected.")] + [else + (send/suspend/dynamic + (lambda (k-url) + (bootstrap-response "Confirm bulk operation" + `(div ((class "confirm-bulk-operation")) + (h2 "You are about to " (code ,action) " the following packages:") + (ul ,@(map (lambda (p) `(li ,p)) + package-names)) + (p "This cannot be undone.") + (form ((action ,k-url) (method "post")) + (button ((class "btn btn-default") (type "submit")) + "Confirm bulk operation")))))) + (match action + ["make-ring-0" (update-package-rings! package-names 0)] + ["make-ring-1" (update-package-rings! package-names 1)] + ["make-ring-2" (update-package-rings! package-names 2)] + [_ (error 'bulk-operation-page "No such action: ~a" action)]) + (bootstrap-response "Bulk operation complete." + `(a ((href ,(main-page-url))) "Return to main index page."))])]))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; TODO: fold the collection of this information into the package ;; database itself. (define (update-external-package-information! package-name) diff --git a/static/todos.js b/static/package-list.js similarity index 73% rename from static/todos.js rename to static/package-list.js index eb1648b..4adfcd4 100644 --- a/static/todos.js +++ b/static/package-list.js @@ -1,3 +1,12 @@ +// Functions related to package listings as produced by `package-summary-table` in site.rkt + +function toggleBulkOperationSelections() { + var checkboxes = Array.from(document.querySelectorAll("input.selected-packages")); + var anySelected = checkboxes.some(function (n) { return n.checked; }); + var newState = anySelected ? false : true; + checkboxes.forEach(function (n) { n.checked = newState; }); +} + $(function() { "use strict"; diff --git a/static/style.css b/static/style.css index 371eee5..2aab4be 100644 --- a/static/style.css +++ b/static/style.css @@ -98,6 +98,20 @@ input#new_version { margin: 0; } +.confirm-bulk-operation { + background-color: #ffdddd; + padding: 2em; + display: block; + border: solid black 1rem; + font-size: 120%; +} +.confirm-bulk-operation h2 { + margin: 0; +} +.confirm-bulk-operation ul { + margin: 2em; +} + .package-count { font-size: 120%; }