Pull some divs out of the issue view

To make it easier to read.

1 files changed, 198 insertions, 188 deletions

diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm
index 68ed8f1..fc5915d 100644
--- a/guix-qa-frontpage/view/issue.scm
+++ b/guix-qa-frontpage/view/issue.scm
@@ -24,6 +24,200 @@
   (define derivation-changes-counts
     (assq-ref derivation-changes 'counts))
 
+  (define links-div
+    `(div
+      (@ (class "large-screen-float-right"))
+      (h3 "Links")
+      (ul
+       (li
+        (a (@ (href ,(simple-format #f "https://issues.guix.gnu.org/~A"
+                                    issue-number)))
+           "View issue on issues.guix.gnu.org"))
+       (li
+        (a (@ (href
+               ,(let ((branch-name
+                       (simple-format #f "issue-~A" issue-number))
+                      (base-tag
+                       (simple-format #f "base-for-issue-~A" issue-number)))
+                  (simple-format
+                   #f
+                   "~A/log/?h=~A&qt=range&q=~A..~A"
+                   "https://git.guix-patches.cbaines.net/guix-patches"
+                   branch-name base-tag branch-name))))
+           "View Git branch"))
+       (li
+        (a (@ (href ,(assoc-ref series "web_url")))
+           "View series on Patchwork"))
+       ,@(if comparison-link
+             `((li
+                (a (@ (href ,comparison-link))
+                   "View Guix Data Service comparison")))
+             '())
+       (li
+        (a (@ (href
+               ,(string-append
+                 "mailto:control@debbugs.gnu.org?"
+                 "subject="
+                 (uri-encode
+                  (simple-format #f "tag ~A moreinfo" issue-number))
+                 "&body="
+                 (uri-encode
+                  (string-append
+                   (simple-format #f "tags ~A ~A moreinfo"
+                                  issue-number
+                                  (if tagged-as-moreinfo?
+                                      "-"
+                                      "+"))
+                   "\nquit\n")))))
+           ,(if tagged-as-moreinfo?
+                "Remove moreinfo tag"
+                "Mark as moreinfo"))))))
+
+  (define lint-warnings-div
+    `(div
+      (h3 "Lint warnings")
+      (table
+       (thead
+        (tr
+         (th "Change")
+         (th "Linter")
+         (th "Message")))
+       (tbody
+        ,@(if (and comparison-details
+                   (not (assq-ref comparison-details 'exception)))
+              (if (eq? (vector-length (assoc-ref comparison-details "lint_warnings"))
+                       0)
+                  `((tr
+                     (td (@ (colspan 3))
+                         "No lint warning changes"
+                         (br)
+                         (small "(for lint checkers that don't require the network)"))))
+                  (append-map
+                   (lambda (package-warnings)
+                     (filter-map
+                      (lambda (warning)
+                        (let ((checker (assoc-ref warning "checker")))
+                          (if (string=? (assoc-ref checker "name")
+                                        "derivation")
+                              #f
+                              `(tr
+                                (td (@ (style ,(string-join
+                                                `("border-left-width: 0.35em;"
+                                                  "border-left-style: solid;"
+                                                  ,(string-append
+                                                    "border-left-color: "
+                                                    (if (string=? (assoc-ref warning "change")
+                                                                  "new")
+                                                        "red"
+                                                        "green"))))))
+                                    ,(assoc-ref warning "change"))
+                                (td
+                                 (span (@ (class "monospace")
+                                          (style "display: block;"))
+                                       ,(assoc-ref checker "name"))
+                                 (p (@ (style "font-size: small;"))
+                                    ,(assoc-ref checker "description")))
+                                (td ,(assoc-ref warning "message"))))))
+                      (vector->list
+                       (assoc-ref package-warnings "warnings"))))
+                   (vector->list
+                    (assoc-ref comparison-details "lint_warnings"))))
+              `((tr
+                 (td (@ (colspan 3)
+                        (class "bad"))
+                     "Comparison unavailable"
+                     ,@(or (and=>
+                            (assq-ref comparison-details 'exception)
+                            (lambda (exception)
+                              (and=>
+                               (assq-ref comparison-details 'invalid_query_parameters)
+                               (lambda (invalid-params)
+                                 (let ((target-commit
+                                        (assoc-ref invalid-params "target_commit")))
+                                   (cond
+                                    (target-commit
+                                     (let ((error (assq-ref target-commit 'error))
+                                           (value (assq-ref target-commit 'value)))
+                                       `((p
+                                          ,(cond
+                                            ((eq? error 'yet-to-process-revision)
+                                             "Yet to process ")
+                                            ((eq? error 'failed-to-process-revision)
+                                             "Failed to process ")
+                                            (else
+                                             "Unknown issue with "))
+                                          (a (@ (href ,(string-append
+                                                        "https://data.qa.guix.gnu.org/revision/"
+                                                        value)))
+                                             "revision")))))
+                                    (else
+                                     #f)))))))
+                           '())))))))))
+
+  (define package-changes-div
+    `(div
+      (h3 "Package changes")
+
+      ,@(if (or (not builds-missing?)
+                (eq? #f systems-with-low-substitute-availability)
+                (null? systems-with-low-substitute-availability)
+                (not comparison-details)
+                (assq-ref comparison-details 'exception)
+                (null? derivation-changes-counts))
+            '()
+            ;; TODO: Only show (and apply) this if it relates to these
+            ;; changes. So just look at the systems relevant to the changes.
+            `((p (@ (style ,(string-join
+                             '("text-align: center;"
+                               "font-weight: bold;"
+                               "padding: 1rem;"
+                               "max-width: 46rem;"
+                               "border-width: 0.35em;"
+                               "border-style: dashed;"
+                               "border-color: red"))))
+                 "Builds for this patch series not yet submitted as "
+                 (a (@ (href "/branch/master"))
+                    "master branch substitute availability")
+                 " is low for: "
+                 ,@(append-map
+                    (lambda (system)
+                      `((span (@ (style "font-family: monospace; white-space: nowrap;"))
+                              ,system
+                              " ")))
+                    systems-with-low-substitute-availability))))
+
+      ,(package-changes-summary-table
+        (let ((revisions (assoc-ref change-details "revisions")))
+          `((base . ,(assoc-ref (assoc-ref revisions "base")
+                                "commit"))
+            (target . ,(assoc-ref (assoc-ref revisions "target")
+                                  "commit"))))
+        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")))
+
+      (div
+       (label (@ (for "notes")) "Notes")
+       (textarea (@ (id "notes"))))))
+
   (layout
    #:title (simple-format #f "Issue ~A" issue-number)
    #:head
@@ -58,53 +252,7 @@ td.bad {
 "))
    #:body
    `((main
-      (div
-       (@ (class "large-screen-float-right"))
-       (h3 "Links")
-       (ul
-        (li
-         (a (@ (href ,(simple-format #f "https://issues.guix.gnu.org/~A"
-                                     issue-number)))
-            "View issue on issues.guix.gnu.org"))
-        (li
-         (a (@ (href
-                ,(let ((branch-name
-                        (simple-format #f "issue-~A" issue-number))
-                       (base-tag
-                        (simple-format #f "base-for-issue-~A" issue-number)))
-                   (simple-format
-                    #f
-                    "~A/log/?h=~A&qt=range&q=~A..~A"
-                    "https://git.guix-patches.cbaines.net/guix-patches"
-                    branch-name base-tag branch-name))))
-            "View Git branch"))
-        (li
-         (a (@ (href ,(assoc-ref series "web_url")))
-            "View series on Patchwork"))
-        ,@(if comparison-link
-              `((li
-                 (a (@ (href ,comparison-link))
-                    "View Guix Data Service comparison")))
-              '())
-        (li
-         (a (@ (href
-                ,(string-append
-                  "mailto:control@debbugs.gnu.org?"
-                  "subject="
-                  (uri-encode
-                   (simple-format #f "tag ~A moreinfo" issue-number))
-                  "&body="
-                  (uri-encode
-                   (string-append
-                    (simple-format #f "tags ~A ~A moreinfo"
-                                   issue-number
-                                   (if tagged-as-moreinfo?
-                                       "-"
-                                       "+"))
-                    "\nquit\n")))))
-            ,(if tagged-as-moreinfo?
-                 "Remove moreinfo tag"
-                 "Mark as moreinfo")))))
+      ,links-div
 
       (h2 ,(assoc-ref series "name")
           ,@(map
@@ -119,147 +267,9 @@ td.bad {
             `(li ,(assoc-ref patch "name")))
           (assoc-ref series "patches")))
 
-      (div
-       (h3 "Lint warnings")
-       (table
-        (thead
-         (tr
-          (th "Change")
-          (th "Linter")
-          (th "Message")))
-        (tbody
-         ,@(if (and comparison-details
-                    (not (assq-ref comparison-details 'exception)))
-               (if (eq? (vector-length (assoc-ref comparison-details "lint_warnings"))
-                        0)
-                   `((tr
-                      (td (@ (colspan 3))
-                          "No lint warning changes"
-                          (br)
-                          (small "(for lint checkers that don't require the network)"))))
-                   (append-map
-                    (lambda (package-warnings)
-                      (filter-map
-                       (lambda (warning)
-                         (let ((checker (assoc-ref warning "checker")))
-                           (if (string=? (assoc-ref checker "name")
-                                         "derivation")
-                               #f
-                               `(tr
-                                 (td (@ (style ,(string-join
-                                                 `("border-left-width: 0.35em;"
-                                                   "border-left-style: solid;"
-                                                   ,(string-append
-                                                     "border-left-color: "
-                                                     (if (string=? (assoc-ref warning "change")
-                                                                   "new")
-                                                         "red"
-                                                         "green"))))))
-                                     ,(assoc-ref warning "change"))
-                                 (td
-                                  (span (@ (class "monospace")
-                                           (style "display: block;"))
-                                        ,(assoc-ref checker "name"))
-                                  (p (@ (style "font-size: small;"))
-                                     ,(assoc-ref checker "description")))
-                                 (td ,(assoc-ref warning "message"))))))
-                       (vector->list
-                        (assoc-ref package-warnings "warnings"))))
-                    (vector->list
-                     (assoc-ref comparison-details "lint_warnings"))))
-               `((tr
-                  (td (@ (colspan 3)
-                         (class "bad"))
-                      "Comparison unavailable"
-                      ,@(or (and=>
-                             (assq-ref comparison-details 'exception)
-                             (lambda (exception)
-                               (and=>
-                                (assq-ref comparison-details 'invalid_query_parameters)
-                                (lambda (invalid-params)
-                                  (let ((target-commit
-                                         (assoc-ref invalid-params "target_commit")))
-                                    (cond
-                                     (target-commit
-                                      (let ((error (assq-ref target-commit 'error))
-                                            (value (assq-ref target-commit 'value)))
-                                        `((p
-                                           ,(cond
-                                             ((eq? error 'yet-to-process-revision)
-                                              "Yet to process ")
-                                             ((eq? error 'failed-to-process-revision)
-                                              "Failed to process ")
-                                             (else
-                                              "Unknown issue with "))
-                                           (a (@ (href ,(string-append
-                                                         "https://data.qa.guix.gnu.org/revision/"
-                                                         value)))
-                                              "revision")))))
-                                     (else
-                                      #f)))))))
-                            '()))))))))
-
-      (div
-       (h3 "Package changes")
-
-       ,@(if (or (not builds-missing?)
-                 (eq? #f systems-with-low-substitute-availability)
-                 (null? systems-with-low-substitute-availability)
-                 (not comparison-details)
-                 (assq-ref comparison-details 'exception)
-                 (null? derivation-changes-counts))
-             '()
-             ;; TODO: Only show (and apply) this if it relates to these
-             ;; changes. So just look at the systems relevant to the changes.
-             `((p (@ (style ,(string-join
-                              '("text-align: center;"
-                                "font-weight: bold;"
-                                "padding: 1rem;"
-                                "max-width: 46rem;"
-                                "border-width: 0.35em;"
-                                "border-style: dashed;"
-                                "border-color: red"))))
-                  "Builds for this patch series not yet submitted as "
-                  (a (@ (href "/branch/master"))
-                     "master branch substitute availability")
-                  " is low for: "
-                  ,@(append-map
-                     (lambda (system)
-                       `((span (@ (style "font-family: monospace; white-space: nowrap;"))
-                               ,system
-                               " ")))
-                     systems-with-low-substitute-availability))))
-
-       ,(package-changes-summary-table
-         (let ((revisions (assoc-ref change-details "revisions")))
-           `((base . ,(assoc-ref (assoc-ref revisions "base")
-                                 "commit"))
-             (target . ,(assoc-ref (assoc-ref revisions "target")
-                                   "commit"))))
-         derivation-changes-counts
-         (string-append "/issue/" issue-number)))
-
-      (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")))
-
-       (div
-        (label (@ (for "notes")) "Notes")
-        (textarea (@ (id "notes")))))
+      ,lint-warnings-div
+      ,package-changes-div
+      ,review-checklist-div
 
       (div
        (h3 "Badges (work in progress)")