Add a new package changes page

And make some refactoring to make this easier.

9 files changed, 602 insertions, 189 deletions

diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm
index 5e84df2..df6fdd3 100644
--- a/guix-qa-frontpage/branch.scm
+++ b/guix-qa-frontpage/branch.scm
@@ -182,40 +182,59 @@
                (lambda (exn)
                  (if (guix-data-service-error? exn)
                      (guix-data-service-error->sexp exn)
-                     `((exception . ,(simple-format #f "~A" exn)))))
+                     (begin
+                       (simple-format
+                        (current-error-port)
+                        "exception checking if branch is up to date (~A): ~A\n"
+                        branch-name
+                        exn)
+                       `((exception . ,(simple-format #f "~A" exn))))))
              (lambda ()
-               (let* ((master-revision
-                       (get-latest-processed-branch-revision "master"))
-                      (changes
-                       (length
-                        (revision-derivation-changes
-                         (revision-derivation-changes-url
-                          `((base   . ,merge-base)
-                            (target . ,master-revision))
-                          ;; TODO: Maybe do something smarter here?
-                          #:systems '("x86_64-linux"))))))
-                 `((up-to-date? . ,(< changes 3000))
-                   (changes     . ,changes)
-                   (master      . ,master-revision))))
+               (with-throw-handler #t
+                 (lambda ()
+                   (let* ((master-revision
+                           (get-latest-processed-branch-revision "master"))
+                          (changes
+                           (length
+                            (compare-package-derivations
+                             (compare-package-derivations-url
+                              `((base   . ,merge-base)
+                                (target . ,master-revision))
+                              ;; TODO: Maybe do something smarter here?
+                              #:systems '("x86_64-linux"))))))
+                     `((up-to-date? . ,(< changes 3000))
+                       (changes     . ,changes)
+                       (master      . ,master-revision))))
+                 (lambda _
+                   (backtrace))))
              #:unwind? #t))
 
-          (derivation-changes-counts
+          (derivation-changes
            (with-exception-handler
                (lambda (exn)
                  (if (guix-data-service-error? exn)
                      (guix-data-service-error->sexp exn)
-                     `((exception . ,(simple-format #f "~A" exn)))))
+                     (begin
+                       (simple-format
+                        (current-error-port)
+                        "exception fetching branch derivation changes (~A): ~A\n"
+                        branch-name
+                        exn)
+                       `((exception . ,(simple-format #f "~A" exn))))))
              (lambda ()
-               (let ((derivation-changes-data
-                      change-details
-                      (revision-derivation-changes
-                       (revision-derivation-changes-url
-                        revisions
-                        #:systems %systems-to-submit-builds-for))))
-
-                 (derivation-changes-counts
-                  derivation-changes-data
-                  %systems-to-submit-builds-for)))
+               (with-throw-handler #t
+                 (lambda ()
+                   (let ((derivation-changes-data
+                          (compare-package-derivations
+                           (compare-package-derivations-url
+                            revisions
+                            #:systems %systems-to-submit-builds-for))))
+
+                     (derivation-changes
+                      derivation-changes-data
+                      %systems-to-submit-builds-for)))
+                 (lambda _
+                   (backtrace))))
              #:unwind? #t))
 
           (substitute-availability
@@ -223,7 +242,13 @@
                (lambda (exn)
                  (if (guix-data-service-error? exn)
                      (guix-data-service-error->sexp exn)
-                     `((exception . ,(simple-format #f "~A" exn)))))
+                     (begin
+                       (simple-format
+                        (current-error-port)
+                        "exception fetching branch substitute availability (~A): ~A\n"
+                        branch-name
+                        exn)
+                       `((exception . ,(simple-format #f "~A" exn))))))
              (lambda ()
                (package-substitute-availability
                 (package-substitute-availability-url
@@ -242,7 +267,7 @@
 
      (values
       revisions
-      derivation-changes-counts
+      derivation-changes
       substitute-availability
       up-to-date-with-master?
       master-branch-systems-with-low-substitute-availability))
@@ -390,6 +415,7 @@
                            branch-data
                            #:args
                            (list branch-name)
+                           #:version 2
                            #:ttl (/ frequency 2))))
 
                      (update-branch-substitute-availability-metrics
diff --git a/guix-qa-frontpage/derivation-changes.scm b/guix-qa-frontpage/derivation-changes.scm
index 1283082..6953603 100644
--- a/guix-qa-frontpage/derivation-changes.scm
+++ b/guix-qa-frontpage/derivation-changes.scm
@@ -18,70 +18,82 @@
 
 (define-module (guix-qa-frontpage derivation-changes)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-43)
   #:use-module (ice-9 match)
   #:export (categorise-packages
-            derivation-changes-counts))
+            derivation-changes))
 
 (define (categorise-packages derivation-changes side)
-  (fold
-   (match-lambda*
-     ((package result)
-      (fold
-       ;; builds for specific system and target
-       (lambda (details result)
-         (let* ((system (assoc-ref details "system"))
-                (target (assoc-ref details "target"))
-                (build-statuses
-                 ;; Invent a new status here "blocked"
-                 (map (lambda (build)
-                        (let ((status
-                               (assoc-ref build "status")))
-                          (if (and (string=? status "scheduled")
-                                   (assoc-ref build "potentially_blocked"))
-                              "blocked"
-                              status)))
-                      (vector->list
-                       (assoc-ref details "builds"))))
-                (category
-                 (cond
-                  ((member "succeeded" build-statuses)
-                   'succeeding)
-                  ((and (not (member "succeeded" build-statuses))
-                        (member "failed" build-statuses))
-                   'failing)
-                  ((member "blocked" build-statuses)
-                   'blocked)
-                  (else
-                   'unknown))))
+  (define (vector-member? s v)
+    (->bool
+     (vector-index
+      (lambda (e)
+        (string=? e s))
+      v)))
 
-           (let* ((system+target
-                   (if (string-null? target)
-                       system
-                       (cons system target)))
-                  (categorised-packages
-                   (or (assoc-ref result system+target)
-                       '())))
-             `((,system+target
-                .
-                ((,category . ,(cons
-                                (cons (assoc-ref package "name")
-                                      (assoc-ref package "version"))
-                                (or (assq-ref categorised-packages category)
-                                    '())))
-                 ,@(alist-delete category categorised-packages)))
-               ,@(alist-delete system+target result)))))
-       result
-       (vector->list
-        (assoc-ref package side)))))
+  (vector-fold
+   (lambda (_ result package)
+     (vector-fold
+      ;; builds for specific system and target
+      (lambda (_ result details)
+        (let* ((system (assoc-ref details "system"))
+               (target (assoc-ref details "target"))
+               (build-statuses
+                ;; Invent a new status here "blocked"
+                (vector-map
+                 (lambda (_ build)
+                   (let ((status
+                          (assoc-ref build "status")))
+                     (if (and (string=? status "scheduled")
+                              (assoc-ref build "potentially_blocked"))
+                         "blocked"
+                         status)))
+                 (assoc-ref details "builds")))
+               (category
+                (cond
+                 ((vector-member? "succeeded" build-statuses)
+                  'succeeding)
+                 ((and (not (vector-member? "succeeded" build-statuses))
+                       (vector-member? "failed" build-statuses))
+                  'failing)
+                 ((vector-member? "blocked" build-statuses)
+                  'blocked)
+                 (else
+                  'unknown))))
+
+          (let* ((system+target
+                  (if (string-null? target)
+                      system
+                      (cons system target)))
+                 (categorised-packages
+                  (or (assoc-ref result system+target)
+                      '())))
+            `((,system+target
+               .
+               ((,category . ,(cons
+                               (cons (assoc-ref package "name")
+                                     (assoc-ref package "version"))
+                               (or (assq-ref categorised-packages category)
+                                   '())))
+                ,@(alist-delete category categorised-packages)))
+              ,@(alist-delete system+target result)))))
+      result
+      (assoc-ref package side)))
    '()
    derivation-changes))
 
-(define (derivation-changes-counts derivation-changes all-systems)
-  (let* ((categorised-base-packages-by-system
-          (categorise-packages derivation-changes "base"))
-         (categorised-target-packages-by-system
-          (categorise-packages derivation-changes "target")))
+(define (derivation-changes derivation-changes all-systems)
+  (define categorised-base-packages-by-system
+    (categorise-packages (assoc-ref derivation-changes
+                                    "derivation_changes")
+                         "base"))
+
+  (define categorised-target-packages-by-system
+    (categorise-packages (assoc-ref derivation-changes
+                                    "derivation_changes")
+                         "target"))
 
+  (define counts
     (if (null? categorised-target-packages-by-system)
         '()
         (map
@@ -125,4 +137,7 @@
                     (lambda (s)
                       (string=? (car b) s))
                     all-systems)
-                   10))))))))
+                   10)))))))
+
+  `(,@derivation-changes
+    (counts  . ,counts)))
diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index c35881c..fbb41ee 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -19,8 +19,8 @@
 
             guix-data-service-error->sexp
 
-            revision-derivation-changes-url
-            revision-derivation-changes
+            compare-package-derivations-url
+            compare-package-derivations
 
             revision-comparison-url
             revision-comparison
@@ -118,7 +118,7 @@
                        (< (guix-data-service-error-response-code exn)
                           500))))))
 
-(define* (revision-derivation-changes-url base-and-target-refs #:key systems)
+(define* (compare-package-derivations-url base-and-target-refs #:key systems)
   (string-append
    "https://data.qa.guix.gnu.org/compare/package-derivations.json?"
    "base_commit=" (assq-ref base-and-target-refs 'base)
@@ -131,16 +131,12 @@
    "&target=none"
    "&field=builds&limit_results=&all_results=on"))
 
-(define (revision-derivation-changes url)
+(define (compare-package-derivations url)
   (let ((json-body
          (guix-data-service-request url)))
     (if json-body
-        (values (vector->list
-                 (assoc-ref json-body
-                            "derivation_changes"))
-                (alist-delete "derivation_changes"
-                              json-body))
-        (values #f #f))))
+        json-body
+        #f)))
 
 (define* (revision-comparison-url base-and-target-refs #:key (json? #t))
   (string-append
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index abcf96e..3cc9516 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -119,60 +119,59 @@
           (get-issue-branch-base-and-target-refs
            number))
          (derivation-changes-data
-          change-details
           (if base-and-target-refs
               (with-exception-handler
                   (lambda (exn)
-                    (values
-                     (if (guix-data-service-error? exn)
-                         `((exception . guix-data-service-invalid-parameters)
-                           (invalid_query_parameters
-                            .
-                            ,(filter-map
-                              (match-lambda
-                                ((param . val)
-                                 (and=>
-                                  (assoc-ref val "invalid_value")
-                                  (lambda (value)
-                                    (let ((message
-                                           (assoc-ref val "message")))
-                                      (cons
-                                       param
-                                       `((value . ,value)
-                                         (error
-                                          ;; Convert the HTML error messages
-                                          ;; to something easier to handle
-                                          . ,(cond
-                                              ((string-contains message
-                                                                "failed to process revision")
-                                               'failed-to-process-revision)
-                                              ((string-contains message
-                                                                "yet to process revision")
-                                               'yet-to-process-revision)
-                                              (else
-                                               'unknown))))))))))
-                              (assoc-ref
-                               (guix-data-service-error-response-body exn)
-                               "query_parameters"))))
-                         `((exception . ,(simple-format #f "~A" exn))))
-                     #f))
+                    (if (guix-data-service-error? exn)
+                        `((exception . guix-data-service-invalid-parameters)
+                          (invalid_query_parameters
+                           .
+                           ,(filter-map
+                             (match-lambda
+                               ((param . val)
+                                (and=>
+                                 (assoc-ref val "invalid_value")
+                                 (lambda (value)
+                                   (let ((message
+                                          (assoc-ref val "message")))
+                                     (cons
+                                      param
+                                      `((value . ,value)
+                                        (error
+                                         ;; Convert the HTML error messages
+                                         ;; to something easier to handle
+                                         . ,(cond
+                                             ((string-contains message
+                                                               "failed to process revision")
+                                              'failed-to-process-revision)
+                                             ((string-contains message
+                                                               "yet to process revision")
+                                              'yet-to-process-revision)
+                                             (else
+                                              'unknown))))))))))
+                             (assoc-ref
+                              (guix-data-service-error-response-body exn)
+                              "query_parameters"))))
+                        `((exception . ,(simple-format #f "~A" exn)))))
                 (lambda ()
-                  (revision-derivation-changes
-                   (revision-derivation-changes-url
+                  (compare-package-derivations
+                   (compare-package-derivations-url
                     base-and-target-refs
                     #:systems %systems-to-submit-builds-for)))
                 #:unwind? #t)
-              (values #f #f)))
-         (derivation-changes-counts
-          (if change-details
-              (derivation-changes-counts
+              #f))
+         (derivation-changes
+          (if (and derivation-changes-data
+                   (not (assq-ref derivation-changes-data 'exception)))
+              (derivation-changes
                derivation-changes-data
                %systems-to-submit-builds-for)
               #f))
          (builds-missing?
-          (if change-details
+          (if derivation-changes
               (builds-missing-for-derivation-changes?
-               derivation-changes-data)
+               (assoc-ref derivation-changes-data
+                          "derivation_changes"))
               #t))
          (comparison-details
           (and
@@ -218,8 +217,10 @@
 
     (values
      base-and-target-refs
-     derivation-changes-counts
-     change-details
+     derivation-changes
+     (and=> derivation-changes-data
+            (lambda (changes)
+              (alist-delete "derivation_changes" changes)))
      builds-missing?
      comparison-details)))
 
@@ -261,7 +262,7 @@
                #f)
            (lambda ()
              (let ((base-and-target-refs
-                    derivation-changes-counts
+                    derivation-changes
                     change-details
                     builds-missing?
                     comparison-details
@@ -271,6 +272,7 @@
                      issue-data
                      #:args
                      (list (car series))
+                     #:version 2
                      #:ttl (/ frequency 2))))
 
                (with-sqlite-cache
@@ -278,7 +280,7 @@
                 'issue-patches-overall-status
                 (lambda (id)
                   (issue-patches-overall-status
-                   derivation-changes-counts
+                   (assq-ref derivation-changes 'counts)
                    builds-missing?
                    (assq-ref (assq-ref series 'mumi)
                              'tags)))
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index a83d8d6..d1d797a 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -1,5 +1,6 @@
 (define-module (guix-qa-frontpage manage-builds)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-43)
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 streams)
@@ -56,13 +57,12 @@
          (and=>
           (get-issue-branch-base-and-target-refs issue-number)
           (lambda (base-and-target-refs)
-            (revision-derivation-changes-url
+            (compare-package-derivations-url
              base-and-target-refs
              #:systems %systems-to-submit-builds-for)))))
 
     (if derivation-changes-url
         (let ((derivation-changes-data
-               change-details
                (with-exception-handler
                    (lambda (exn)
                      (simple-format
@@ -71,12 +71,12 @@
                       issue-number
                       exn)
 
-                     (values #f #f))
+                     #f)
                  (lambda ()
                    (with-sqlite-cache
                     database
                     'derivation-changes
-                    revision-derivation-changes
+                    compare-package-derivations
                     #:args
                     (list derivation-changes-url)
                     #:ttl (* 60 20)))
@@ -86,7 +86,7 @@
             (let ((target-commit
                    (assoc-ref
                     (assoc-ref
-                     (assoc-ref change-details
+                     (assoc-ref derivation-changes-data
                                 "revisions")
                      "target")
                     "commit")))
@@ -208,13 +208,12 @@
             (target . ,branch-commit)))
 
          (derivation-changes-url
-          (revision-derivation-changes-url
+          (compare-package-derivations-url
            revisions
            #:systems %systems-to-submit-builds-for)))
 
     (if derivation-changes-url
         (let ((derivation-changes-data
-               change-details
                (with-exception-handler
                    (lambda (exn)
                      (simple-format
@@ -223,12 +222,12 @@
                       branch
                       exn)
 
-                     (values #f #f))
+                     #f)
                  (lambda ()
                    (with-sqlite-cache
                     database
                     'branch-derivation-changes
-                    revision-derivation-changes
+                    compare-package-derivations
                     #:args
                     (list derivation-changes-url)
                     #:ttl 0))
@@ -238,7 +237,7 @@
             (let ((target-commit
                    (assoc-ref
                     (assoc-ref
-                     (assoc-ref change-details
+                     (assoc-ref derivation-changes-data
                                 "revisions")
                      "target")
                     "commit")))
@@ -406,10 +405,13 @@
              #t
              #f)
          #f))
-   (append-map! (lambda (package)
-                  (vector->list
-                   (assoc-ref package "target")))
-                derivation-changes)))
+   (vector-fold
+    (lambda (_ result package)
+      (append! result
+               (vector->list
+                (assoc-ref package "target"))))
+    '()
+    derivation-changes)))
 
 
 (define* (submit-builds-for-category build-coordinator
@@ -456,10 +458,13 @@
      build-ids-to-keep-set))
 
   (let loop ((changes
-              (append-map! (lambda (package)
-                             (vector->list
-                              (assoc-ref package "target")))
-                           derivation-changes))
+              (vector-fold
+               (lambda (_ result package)
+                 (append! result
+                          (vector->list
+                           (assoc-ref package "target"))))
+               '()
+               (assoc-ref derivation-changes "derivation_changes")))
              (builds-to-submit-details '())
              (build-ids-to-keep-set (set)))
 
diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm
index 7496724..b29cf67 100644
--- a/guix-qa-frontpage/manage-patch-branches.scm
+++ b/guix-qa-frontpage/manage-patch-branches.scm
@@ -232,13 +232,15 @@
       (define get-changes-compared-to-master
         (memoize
          (lambda (base-commit)
-           (length
-            (revision-derivation-changes
-             (revision-derivation-changes-url
-              `((base   . ,base-commit)
-                (target . ,latest-master-revision))
-              ;; TODO: Maybe do something smarter here?
-              #:systems '("x86_64-linux")))))))
+           (vector-length
+            (assoc-ref
+             (compare-package-derivations
+              (compare-package-derivations-url
+               `((base   . ,base-commit)
+                 (target . ,latest-master-revision))
+               ;; TODO: Maybe do something smarter here?
+               #:systems '("x86_64-linux")))
+             "derivation_changes")))))
 
       (simple-format #t "checking for branches to delete (looking at ~A branches)\n"
                      (length issue-numbers))
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 48f03f7..d7ad216 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -31,6 +31,8 @@
   #:use-module (fibers web server)
   #:use-module (guix store)
   #:use-module (guix-data-service web util)
+  #:use-module ((guix-data-service web query-parameters)
+                #:select (parse-query-string))
   #:use-module ((guix-build-coordinator utils)
                 #:select (with-time-logging get-gc-metrics-updater
                           call-with-delay-logging))
@@ -149,7 +151,7 @@
           (master-branch-view substitute-availability))))
       (('GET "branch" branch)
        (let ((revisions
-              derivation-changes-counts
+              derivation-changes
               substitute-availability
               up-to-date-with-master
               master-branch-systems-with-low-substitute-availability
@@ -159,15 +161,41 @@
                branch-data
                #:args
                (list branch)
+               #:version 2
                #:ttl 6000)))
          (render-html
           #:sxml
           (branch-view branch
                        revisions
-                       derivation-changes-counts
+                       derivation-changes
                        substitute-availability
                        up-to-date-with-master
                        master-branch-systems-with-low-substitute-availability))))
+      (('GET "branch" branch "package-changes")
+       (let ((revisions
+              derivation-changes
+              substitute-availability
+              up-to-date-with-master
+              master-branch-systems-with-low-substitute-availability
+              (with-sqlite-cache
+               database
+               'branch-data
+               branch-data
+               #:args
+               (list branch)
+               #:version 2
+               #:ttl 6000)))
+         (render-html
+          #:sxml
+          (branch-package-changes-view branch
+                                       revisions
+                                       derivation-changes
+                                       up-to-date-with-master
+                                       (or
+                                        (and=>
+                                         (uri-query (request-uri request))
+                                         parse-query-string)
+                                        '())))))
       (('GET "patches")
        (let* ((latest-series
                (with-sqlite-cache
@@ -378,7 +406,7 @@
                                (string->number number))))
          (if series
              (let* ((base-and-target-refs
-                     derivation-changes-counts
+                     derivation-changes
                      change-details
                      builds-missing?
                      comparison-details
@@ -388,6 +416,7 @@
                       issue-data
                       #:args
                       (list (string->number number))
+                      #:version 2
                       #:ttl 6000))
                     (master-branch-substitute-availability
                      (with-sqlite-cache
@@ -411,7 +440,7 @@
                                         (revision-comparison-url
                                          base-and-target-refs
                                          #:json? #f))
-                                   derivation-changes-counts
+                                   derivation-changes
                                    builds-missing?
                                    change-details
                                    comparison-details
diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm
index 7847360..830b5cb 100644
--- a/guix-qa-frontpage/view/branch.scm
+++ b/guix-qa-frontpage/view/branch.scm
@@ -1,15 +1,18 @@
 (define-module (guix-qa-frontpage view branch)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-43)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module ((guix-data-service model utils) #:select (group-to-alist))
   #:use-module (guix-qa-frontpage manage-builds)
   #:use-module (guix-qa-frontpage derivation-changes)
   #:use-module (guix-qa-frontpage view util)
   #:export (branch-view
+            branch-package-changes-view
 
             master-branch-view))
 
-(define (branch-view branch revisions derivation-changes-counts
+(define (branch-view branch revisions derivation-changes
                      substitute-availability
                      up-to-date-with-master
                      master-branch-systems-with-low-substitute-availability)
@@ -24,6 +27,9 @@
          (simple-format #f "&build_change=~A" build-change)
          "")))
 
+  (define derivation-changes-counts
+    (assq-ref derivation-changes 'counts))
+
   (layout
    #:title (simple-format #f "Branch ~A" branch)
    #:head
@@ -230,11 +236,11 @@ td.bad {
                           "No package derivation changes")))
                    (map
                     (match-lambda
-                      ((system . counts)
+                      ((system . derivations)
 
                        (define (count side status)
                          (assoc-ref (assoc-ref
-                                     counts
+                                     derivations
                                      side)
                                     status))
                        `(tr
@@ -248,22 +254,48 @@ td.bad {
                                            0))
                                    `((@ (class "good")))
                                    '())
-                             ,(count 'target 'succeeding))
-                         ,(if (> (count 'target 'failing)
-                                 (count 'base 'failing))
-                              `(td (@ (class "bad"))
-                                   ,(count 'target 'failing))
-                              `(td ,(count 'target 'failing)))
-                         ,(if (> (count 'target 'blocked)
-                                 (count 'base 'blocked))
-                              `(td (@ (class "bad"))
-                                   ,(count 'target 'blocked))
-                              `(td ,(count 'target 'blocked)))
-                         ,(if (> (count 'target 'unknown)
-                                 (count 'base 'unknown))
-                              `(td (@ (class "bad"))
-                                   ,(count 'target 'unknown))
-                              `(td ,(count 'target 'unknown)))
+                             (a (@ (href
+                                    ,(string-append
+                                      "/branch/" branch
+                                      "/package-changes?"
+                                      system "-change=fixed&"
+                                      system "-change=still-working&"
+                                      system "-change=new-working")))
+                                ,(count 'target 'succeeding)))
+                         (td ,@(if (> (count 'target 'failing)
+                                      (count 'base 'failing))
+                                   '((@ (class "bad")))
+                                   '())
+                             (a (@ (href
+                                    ,(string-append
+                                      "/branch/" branch
+                                      "/package-changes?"
+                                      system "-change=broken&"
+                                      system "-change=still-failing&"
+                                      system "-change=new-failing")))
+                                ,(count 'target 'failing)))
+                         (td ,@(if (> (count 'target 'blocked)
+                                      (count 'base 'blocked))
+                                   '((@ (class "bad")))
+                                   '())
+                             (a (@ (href
+                                    ,(string-append
+                                      "/branch/" branch
+                                      "/package-changes?"
+                                      system "-change=blocked&"
+                                      system "-change=still-blocked&"
+                                      system "-change=new-blocked")))
+                                ,(count 'target 'blocked)))
+                         (td (@ ,@(if (> (count 'target 'unknown)
+                                         (count 'base 'unknown))
+                                      '((class "bad"))
+                                      '()))
+                             (a (@ (href
+                                    ,(string-append
+                                      "/branch/" branch
+                                      "/package-changes?"
+                                      system "-change=unknown")))
+                                ,(count 'target 'unknown)))
                          (td (a (@ (href
                                     ,(package-derivations-comparison-link system)))
                                 "View comparison")))))
@@ -312,6 +344,309 @@ td.bad {
                                 params)))
                             '()))))))))))))
 
+(define* (delete-duplicates/sort! unsorted-lst less #:key (eq eq?))
+  (if (null? unsorted-lst)
+      unsorted-lst
+      (let ((sorted-lst (sort! unsorted-lst less)))
+
+        (let loop ((lst (cdr sorted-lst))
+                   (last-element (car sorted-lst))
+                   (result (list (car sorted-lst))))
+          (if (null? lst)
+              result
+              (let ((current-element (car lst)))
+                (if (eq current-element last-element)
+                    (loop (cdr lst)
+                          last-element
+                          result)
+                    (loop (cdr lst)
+                          current-element
+                          (cons current-element
+                                result)))))))))
+
+(define (branch-package-changes-view branch
+                                     revisions
+                                     derivation-changes
+                                     up-to-date-with-master
+                                     query-parameters)
+  (define (derivation-for-system side system)
+    (vector-any
+     (lambda (derivation)
+       (if (string=? (assoc-ref derivation "system")
+                     system)
+           derivation
+           #f))
+     side))
+
+  (define (builds-by-system base target)
+    (map
+     (lambda (system)
+       (cons
+        system
+        `(("base" . ,(and=>
+                      (derivation-for-system base system)
+                      (lambda (derivation)
+                        (vector->list
+                         (assoc-ref derivation "builds")))))
+          ("target" . ,(and=>
+                        (derivation-for-system target system)
+                        (lambda (derivation)
+                          (vector->list
+                           (assoc-ref derivation "builds"))))))))
+     %systems-to-submit-builds-for))
+
+  (define (derivations-by-system base target)
+    (map
+     (lambda (system)
+       (cons
+        system
+        `(("base" . ,(and=>
+                      (derivation-for-system base system)
+                      (lambda (derivation)
+                        (assoc-ref derivation "derivation-file-name"))))
+          ("target" . ,(and=>
+                        (derivation-for-system target system)
+                        (lambda (derivation)
+                          (assoc-ref derivation "derivation-file-name")))))))
+     %systems-to-submit-builds-for))
+
+  (define (builds->overall-status side-builds)
+    (if (eq? #f side-builds)
+        'not-present
+        (let ((build-statuses
+               (map
+                (lambda (build)
+                  (let ((status
+                         (assoc-ref build "status")))
+                    (if (and (string=? status "scheduled")
+                             (assoc-ref build "potentially_blocked"))
+                        "blocked"
+                        status)))
+                side-builds)))
+          (cond
+           ((member "succeeded" build-statuses)
+            'succeeding)
+           ((and (not (member "succeeded" build-statuses))
+                 (member "failed" build-statuses))
+            'failing)
+           ((member "blocked" build-statuses)
+            'blocked)
+           (else
+            'unknown)))))
+
+  (define %changes
+    '(broken
+      fixed
+      blocked
+      still-working
+      still-failing
+      still-blocked
+      new-working
+      new-failing
+      new-blocked
+      removed-working
+      removed-failing
+      removed-blocked
+      unknown))
+
+  (define (builds->change-by-system builds-by-system)
+    (map
+     (match-lambda
+       ((system . builds)
+        (let ((base-status (builds->overall-status
+                            (assoc-ref builds "base")))
+              (target-status (builds->overall-status
+                              (assoc-ref builds "target"))))
+          (cons
+           system
+           (cond
+            ((and (eq? base-status 'succeeding)
+                  (eq? target-status 'failing))
+             'broken)
+            ((and (eq? base-status 'succeeding)
+                  (eq? target-status 'blocked))
+             'blocked)
+            ((and (or (eq? base-status 'failing)
+                      (eq? base-status 'blocked))
+                  (eq? target-status 'succeeding))
+             'fixed)
+            ((and (eq? 'not-present base-status)
+                  (eq? 'succeeding target-status))
+             'new-working)
+            ((and (eq? 'not-present base-status)
+                  (eq? 'failing target-status))
+             'new-failing)
+            ((and (eq? 'not-present base-status)
+                  (eq? 'blocked target-status))
+             'new-blocked)
+            ((and (eq? 'succeeding base-status)
+                  (eq? 'not-present target-status))
+             'removed-working)
+            ((and (eq? 'failing base-status)
+                  (eq? 'not-present target-status))
+             'removed-failing)
+            ((and (eq? 'blocked base-status)
+                  (eq? 'not-present target-status))
+             'removed-blocked)
+            ((and (eq? base-status target-status 'succeeding))
+             'still-working)
+            ((and (eq? base-status target-status 'failing))
+             'still-failing)
+            ((and (eq? base-status target-status 'blocked))
+             'still-blocked)
+            (else 'unknown))))))
+     builds-by-system))
+
+  (define (display-builds builds derivations change)
+    (define %color-for-change
+      '((fixed           . "green")
+        (broken          . "red")
+        (blocked         . "yellow")
+        (still-working   . "lightgreen")
+        (still-failing   . "#FFCCCB")
+        (still-blocked   . "lightyellow")
+        (new-working     . "lightgreen")
+        (new-failing     . "red")
+        (new-blocked     . "lightyellow")
+        (removed-working . "")
+        (removed-failing . "")
+        (removed-blocked . "")
+        (unknown         . "lightgrey")))
+
+    (if builds
+        (let ((base-status
+               (builds->overall-status
+                (assoc-ref builds "base")))
+              (target-status
+               (builds->overall-status
+                (assoc-ref builds "target"))))
+          (if (and
+               (eq? base-status 'not-present)
+               (eq? target-status 'not-present))
+              '(td)
+              `(td
+                (@ (style ,(simple-format
+                            #f
+                            "background-color: ~A;"
+                            (assq-ref
+                             %color-for-change
+                             change))))
+                ,(if (eq? base-status 'not-present)
+                     `(div "was not present")
+                     `(div
+                       (a (@ (href ,(string-append
+                                     "https://data.qa.guix.gnu.org"
+                                     (assoc-ref derivations "base"))))
+                          "was " ,base-status)))
+                ,(if (eq? target-status 'not-present)
+                     `(div "now not present")
+                     `(div
+                       (a (@ (href ,(string-append
+                                     "https://data.qa.guix.gnu.org"
+                                     (assoc-ref derivations "target"))))
+                          "now " ,target-status))))))
+        '(td)))
+
+  (define grouped-query-parameters
+    (group-to-alist
+     identity
+     query-parameters))
+
+  (define system-change
+    (map
+     (lambda (system)
+       (cons (string-append system "-change")
+             system))
+     %systems-to-submit-builds-for))
+
+  (define (display? package-and-version change-by-system)
+    (every
+     (match-lambda
+       ((key . vals)
+        (cond
+         ((assoc-ref system-change key)
+          (let ((system (assoc-ref system-change key)))
+            (->bool
+             (member (assoc-ref change-by-system system)
+                     (map string->symbol vals)))))
+         (else #t))))
+     grouped-query-parameters))
+
+  (layout
+   #:title (simple-format #f "Branch ~A" branch)
+   #:body
+   `((main
+      (table
+       (form
+        (@ (id "filter-form")
+           (method "get"))
+        (thead
+         (tr
+          (td "Name")
+          (td "Version")
+          ,@(map
+             (lambda (system)
+               `(td ,system
+                    (select
+                     (@ (name
+                         ,(simple-format #f "~A-change"
+                                         system))
+                        (multiple #t))
+                     ,@(let ((system-change-selected-options
+                              (or (assoc-ref
+                                   grouped-query-parameters
+                                   (string-append system "-change"))
+                                  '())))
+                         (map
+                          (match-lambda
+                            ((value . label)
+                             `(option
+                               (@ (value ,value)
+                                  ,@(if (member (symbol->string value)
+                                                system-change-selected-options)
+                                        '((selected ""))
+                                        '()))
+                               ,label)))
+                          (map
+                           (lambda (change)
+                             (cons change change))
+                           %changes))))
+                    (button
+                     (@ (type "submit"))
+                     "Update")))
+             %systems-to-submit-builds-for))))
+       (tbody
+        (@ (style "overflow: auto; max-height: 40em;"))
+        ,@(vector-fold-right
+           (lambda (_ result package-and-version)
+             (let* ((builds
+                     (builds-by-system
+                      (assoc-ref package-and-version "base")
+                      (assoc-ref package-and-version "target")))
+                    (change-by-system
+                     (builds->change-by-system builds))
+                    (derivations
+                     (derivations-by-system
+                      (assoc-ref package-and-version "base")
+                      (assoc-ref package-and-version "target"))))
+               (cons
+                `(tr
+                  (@ ,@(if (display? package-and-version
+                                     change-by-system)
+                           '()
+                           '((style "display: none;"))))
+                  (td ,(assoc-ref package-and-version "name"))
+                  (td ,(assoc-ref package-and-version "version"))
+                  ,@(map
+                     (lambda (system)
+                       (display-builds (assoc-ref builds system)
+                                       (assoc-ref derivations system)
+                                       (assoc-ref change-by-system system)))
+                     %systems-to-submit-builds-for))
+                result)))
+           '()
+           (assoc-ref derivation-changes "derivation_changes"))))))))
+
 (define (master-branch-view substitute-availability)
   (layout
    #:title "Branch master"
diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm
index 133e0a6..62701f8 100644
--- a/guix-qa-frontpage/view/issue.scm
+++ b/guix-qa-frontpage/view/issue.scm
@@ -11,7 +11,7 @@
 
 (define (issue-view issue-number series mumi-tags
                     comparison-link
-                    derivation-changes-counts
+                    derivation-changes
                     builds-missing?
                     change-details comparison-details
                     systems-with-low-substitute-availability)
@@ -34,6 +34,9 @@
   (define tagged-as-moreinfo?
     (member "moreinfo" mumi-tags))
 
+  (define derivation-changes-counts
+    (assq-ref derivation-changes 'counts))
+
   (layout
    #:title (simple-format #f "Issue ~A" issue-number)
    #:head