Add a mechanism to add the reviewed-looks-good usertag to issues

As a way of trying to prioritise merging patches that have been reviewed by
someone.

3 files changed, 144 insertions, 24 deletions

diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 1211ae4..1151d6f 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -533,6 +533,28 @@ has no patches or has been closed.")
                                         (uri-query (request-uri request))
                                         parse-query-string)
                                        '())))))
+      (('GET "issue" number "prepare-review")
+       (let ((revisions
+              derivation-changes
+              substitute-availability
+              up-to-date-with-master
+              master-branch-systems-with-low-substitute-availability
+              (with-sqlite-cache
+               database
+               'issue-data
+               issue-data
+               #:args
+               (list (string->number number))
+               #:version 2
+               #:ttl 6000)))
+         (render-html
+          #:sxml
+          (issue-prepare-review-view number
+                                     (or
+                                      (and=>
+                                       (uri-query (request-uri request))
+                                       parse-query-string)
+                                      '())))))
       (('GET "README")
        (let ((filename (string-append doc-dir "/README.html")))
          (if (file-exists? filename)
diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm
index 5f4dd9d..61c2bd8 100644
--- a/guix-qa-frontpage/view/issue.scm
+++ b/guix-qa-frontpage/view/issue.scm
@@ -2,6 +2,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (web uri)
+  #:use-module (guix-data-service web sxml)
   #:use-module (guix-qa-frontpage issue)
   #:use-module (guix-qa-frontpage manage-builds)
   #:use-module (guix-qa-frontpage guix-data-service)
@@ -9,7 +10,9 @@
   #:use-module (guix-qa-frontpage view util)
   #:use-module (guix-qa-frontpage view shared)
   #:export (issue-view
-            issue-package-changes-view))
+            issue-package-changes-view
+
+            issue-prepare-review-view))
 
 (define (issue-view issue-number series mumi-tags
                     base-and-target-refs
@@ -202,28 +205,57 @@
         derivation-changes-counts
         (string-append "/issue/" issue-number))))
 
-  (define review-checklist-div
-    `(div
-      (h3 "Review checklist")
-      (p "This is just to help anyone reviewing the changes.")
-
-      ,@(map
-         (match-lambda
-           ((id label)
-            `(div
-              (input (@ (type "checkbox")
-                        (id ,id)))
-              (label (@ (for ,id)) ,label))))
-         '(("lint-warnings" "Lint warnings")
-           ("license" "License")
-           ("package-builds" "Package builds")
-           ("package-tests" "Package tests")
-           ("synopsis-and-description" "Synopsis and description")
-           ("commit-messages" "Commit messages")))
+  (define prepare-review-section
+    `(section
+      (form
+       (@ (action ,(simple-format #f "/issue/~A/prepare-review"
+                                  issue-number)))
+       (header
+        (@ (style "padding: 0; margin: 0;"))
+        (h3 "Mark patches as reviewed")
+        (p "This feature is for people other than those involved in submitting the
+patches to record a review, which will highlight that these patches should be
+ready to merge.")
 
-      (div
-       (label (@ (for "notes")) "Notes")
-       (textarea (@ (id "notes"))))))
+        (p "Here's a list of common things to check, tick them off as you review
+the patches:"))
+
+       ,@(map
+          (match-lambda
+            ((id label)
+             `(div
+               (input (@ (type "checkbox")
+                         (id ,id)
+                         (name ,id)))
+               (label (@ (for ,id)) ,label))))
+          '(("lint-warnings" "Are these changes not adding to the lint warnings?")
+            ("package-builds" "Do these changes not cause packages to fail to build?")
+            ("commit-messages" "Are the commit messages written well?")))
+
+       "New packages"
+       (div
+        (@ (style "margin-left: 0.4em;"))
+        ,@(map
+           (match-lambda
+             ((id label)
+              `(div
+                (input (@ (type "checkbox")
+                          (id ,id)
+                          (name ,id)))
+                (label (@ (for ,id)) ,label))))
+           '(("license" "Is the license information complete?")
+             ("package-tests" "Are package tests being run (if available)?")
+             ("synopsis-and-description"
+              "Are the synopsis and description well written?"))))
+
+       (div
+        (label (@ (for "notes")) "Notes to include in the review")
+        (textarea (@ (id "notes")
+                     (name "notes")
+                     (rows 5)
+                     (style "width: 96%"))))
+
+       (button (@ (type "submit")) "Prepare review"))))
 
   (layout
    #:title (simple-format #f "Issue ~A" issue-number)
@@ -297,7 +329,7 @@ div.bad {
                         "patches"))
                (pre ,create-branch-for-issue-log))))
 
-      ,review-checklist-div
+      ,prepare-review-section
 
       (div
        (h3 "Badges (work in progress)")
@@ -312,3 +344,69 @@ div.bad {
    (simple-format #f "Issue ~A" issue-number)
    derivation-changes
    query-parameters))
+
+(define (issue-prepare-review-view issue-number query-parameters)
+  (define (escape str)
+    (call-with-output-string
+      (lambda (port)
+        (sxml->html str port))))
+
+  (define checkboxes
+    ;; Form field name -> text in the email
+    `(("lint-warnings" . "Lint warnings")
+      ("package-builds" . "Package builds")
+      ("commit-messages" . "Commit messages")
+      ("license" . "New package licenses")
+      ("package-tests" . "New package tests")
+      ("synopsis-and-description" . "New package synopsis and descriptions")))
+
+  (define email-text
+    (string-append
+     "user guix
+usertag "
+     issue-number
+     " + reviewed-looks-good
+thanks
+
+Guix QA review form submission:"
+     (or
+      (and=> (assoc-ref (peek "PARAMS" query-parameters) "notes")
+             (lambda (notes)
+               (string-append
+                "\n"
+                (escape notes))))
+      "")
+     (let ((things-checked
+            (filter-map
+             (lambda (param)
+               (if (and (member (car param)
+                                (map car checkboxes))
+                        (string=? (cdr param) "on"))
+                   (assoc-ref checkboxes (car param))
+                   #f))
+             query-parameters)))
+       (if (null? things-checked)
+           "\n\nNo checks recorded."
+           (string-append
+            "\n\nItems marked as checked: "
+            (string-join things-checked ", "))))))
+
+  (layout
+   #:title (simple-format #f "Prepare review - Issue ~A" issue-number)
+   #:body
+   `((main
+      (p "Like patches, reviews are submitted by email.")
+      (a (@ (href
+             ,(string-append
+               "mailto:control@debbugs.gnu.org"
+               (simple-format #f ",~A@debbugs.gnu.org" issue-number)
+               "?"
+               "subject="
+               (uri-encode
+                (simple-format #f "QA review for ~A" issue-number))
+               "&body="
+               (uri-encode email-text))))
+         (b "Open mail client to send review email"))
+      (p "If the above link doesn't work for you, the contents of the suggested email is given below, and can be sent "
+         (strong "to control@debbugs.gnu.org and 66195@debbugs.gnu.org"))
+      (pre ,email-text)))))
diff --git a/guix-qa-frontpage/view/util.scm b/guix-qa-frontpage/view/util.scm
index 0605100..46875aa 100644
--- a/guix-qa-frontpage/view/util.scm
+++ b/guix-qa-frontpage/view/util.scm
@@ -98,7 +98,7 @@ header, main {
     padding: 1rem;
 }
 
-header {
+main > header {
     border-bottom: 2px dashed orange;
 }