From 8a024e26e111941f501b04c43502cc9f2a78c687 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Fri, 2 Oct 2015 20:46:38 -0400
Subject: [PATCH] Support curation/ring-change

---
 src/site.rkt     | 41 ++++++++++++++++++++++++++++++++++++++++-
 static/style.css |  7 ++++++-
 2 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/src/site.rkt b/src/site.rkt
index ebca10f..20b2836 100644
--- a/src/site.rkt
+++ b/src/site.rkt
@@ -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")))
diff --git a/static/style.css b/static/style.css
index e3ac3ce..4862b6c 100644
--- a/static/style.css
+++ b/static/style.css
@@ -138,4 +138,9 @@ th.headerSortDown::after { content: " ▲"; }
     border-radius: 10px;
 }
 .registration-step h1 { margin: 0.5em; }
-.registration-step p { font-size: 140%; }
\ No newline at end of file
+.registration-step p { font-size: 140%; }
+
+.ring-change-link {
+    display: inline-block;
+    padding: 0 0.15em;
+}