Extract the comparison pages out from the main modules

In to their own modules. This should help make the code more understandable,
and allow future refactoring for readability.

4 files changed, 1158 insertions, 1086 deletions

diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
new file mode 100644
index 0000000..7c75767
--- /dev/null
+++ b/guix-data-service/web/compare/controller.scm
@@ -0,0 +1,494 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service web compare controller)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (ice-9 match)
+  #:use-module (guix-data-service web util)
+  #:use-module (guix-data-service web render)
+  #:use-module (guix-data-service web query-parameters)
+  #:use-module (guix-data-service model utils)
+  #:use-module (guix-data-service comparison)
+  #:use-module (guix-data-service model guix-revision)
+  #:use-module (guix-data-service model derivation)
+  #:use-module (guix-data-service model build-status)
+  #:use-module (guix-data-service web compare html)
+  #:export (compare-controller))
+
+(define cache-control-default-max-age
+  (* 60 60 24)) ; One day
+
+(define http-headers-for-unchanging-content
+  `((cache-control
+     . (public
+        (max-age . ,cache-control-default-max-age)))))
+
+(define (parse-system s)
+  s)
+
+(define (parse-build-status s)
+  s)
+
+(define (parse-commit conn)
+  (lambda (s)
+    (if (guix-commit-exists? conn s)
+        s
+        (make-invalid-query-parameter
+         s "unknown commit"))))
+
+(define (compare-controller request
+                            method-and-path-components
+                            mime-types
+                            body
+                            conn)
+  (match method-and-path-components
+    (('GET "compare")
+     (let* ((parsed-query-parameters
+             (parse-query-parameters
+              request
+              `((base_commit   ,(parse-commit conn) #:required)
+                (target_commit ,(parse-commit conn) #:required)))))
+       (render-compare mime-types
+                       conn
+                       parsed-query-parameters)))
+    (('GET "compare-by-datetime")
+     (let* ((parsed-query-parameters
+             (parse-query-parameters
+              request
+              `((base_branch     ,identity #:required)
+                (base_datetime   ,parse-datetime #:required)
+                (target_branch   ,identity #:required)
+                (target_datetime ,parse-datetime #:required)))))
+       (render-compare-by-datetime mime-types
+                                   conn
+                                   parsed-query-parameters)))
+    (('GET "compare" "derivations")
+     (let* ((parsed-query-parameters
+             (parse-query-parameters
+              request
+              `((base_commit   ,(parse-commit conn) #:required)
+                (target_commit ,(parse-commit conn) #:required)
+                (system        ,parse-system #:multi-value)
+                (target        ,parse-system #:multi-value)
+                (build_status  ,parse-build-status #:multi-value)))))
+       (render-compare/derivations mime-types
+                                   conn
+                                   parsed-query-parameters)))
+    (('GET "compare-by-datetime" "derivations")
+     (let* ((parsed-query-parameters
+             (guard-against-mutually-exclusive-query-parameters
+              (parse-query-parameters
+               request
+               `((base_branch     ,identity #:required)
+                 (base_datetime   ,parse-datetime #:required)
+                 (target_branch   ,identity #:required)
+                 (target_datetime ,parse-datetime #:required)
+                 (system          ,parse-system #:multi-value)
+                 (target          ,parse-system #:multi-value)
+                 (build_status    ,parse-build-status #:multi-value)))
+              '((base_commit base_datetime)
+                (target_commit target_datetime)))))
+       (render-compare-by-datetime/derivations mime-types
+                                               conn
+                                               parsed-query-parameters)))
+    (('GET "compare" "packages")
+     (let* ((parsed-query-parameters
+             (parse-query-parameters
+              request
+              `((base_commit   ,(parse-commit conn) #:required)
+                (target_commit ,(parse-commit conn) #:required)))))
+       (render-compare/packages mime-types
+                                conn
+                                parsed-query-parameters)))))
+
+(define (render-compare mime-types
+                        conn
+                        query-parameters)
+  (if (any-invalid-query-parameters? query-parameters)
+      (case (most-appropriate-mime-type
+             '(application/json text/html)
+             mime-types)
+        ((application/json)
+         (render-json
+          '((error . "invalid query"))))
+        (else
+         (render-html
+          #:sxml (compare-invalid-parameters
+                  query-parameters
+                  (match (assq-ref query-parameters 'base_commit)
+                    (($ <invalid-query-parameter> value)
+                     (select-job-for-commit conn value))
+                    (_ #f))
+                  (match (assq-ref query-parameters 'target_commit)
+                    (($ <invalid-query-parameter> value)
+                     (select-job-for-commit conn value))
+                    (_ #f))))))
+
+      (let ((base-revision-id (commit->revision-id
+                               conn
+                               (assq-ref query-parameters 'base_commit)))
+            (target-revision-id (commit->revision-id
+                                 conn
+                                 (assq-ref query-parameters 'target_commit))))
+        (let-values
+            (((base-packages-vhash target-packages-vhash)
+              (package-data->package-data-vhashes
+               (package-differences-data conn
+                                         base-revision-id
+                                         target-revision-id))))
+          (let* ((new-packages
+                  (package-data-vhashes->new-packages base-packages-vhash
+                                                      target-packages-vhash))
+                 (removed-packages
+                  (package-data-vhashes->removed-packages base-packages-vhash
+                                                          target-packages-vhash))
+                 (version-changes
+                  (package-data-version-changes base-packages-vhash
+                                                target-packages-vhash))
+                 (lint-warnings-data
+                  (group-list-by-first-n-fields
+                   2
+                   (lint-warning-differences-data conn
+                                                  base-revision-id
+                                                  target-revision-id))))
+            (case (most-appropriate-mime-type
+                   '(application/json text/html)
+                   mime-types)
+              ((application/json)
+               (render-json
+                `((new-packages . ,(list->vector new-packages))
+                  (removed-packages . ,(list->vector removed-packages))
+                  (version-changes . ,(list->vector
+                                       (map
+                                        (match-lambda
+                                          ((name data ...)
+                                           `((name . ,name)
+                                             ,@data)))
+                                        version-changes))))
+                #:extra-headers http-headers-for-unchanging-content))
+              (else
+               (render-html
+                #:sxml (compare query-parameters
+                                (guix-revisions-cgit-url-bases
+                                 conn
+                                 (list base-revision-id
+                                       target-revision-id))
+                                new-packages
+                                removed-packages
+                                version-changes
+                                lint-warnings-data)
+                #:extra-headers http-headers-for-unchanging-content))))))))
+
+(define (render-compare-by-datetime mime-types
+                                    conn
+                                    query-parameters)
+  (if (any-invalid-query-parameters? query-parameters)
+      (case (most-appropriate-mime-type
+             '(application/json text/html)
+             mime-types)
+        ((application/json)
+         (render-json
+          '((error . "invalid query"))))
+        (else
+         (render-html
+          #:sxml (compare-invalid-parameters
+                  query-parameters
+                  (match (assq-ref query-parameters 'base_commit)
+                    (($ <invalid-query-parameter> value)
+                     (select-job-for-commit conn value))
+                    (_ #f))
+                  (match (assq-ref query-parameters 'target_commit)
+                    (($ <invalid-query-parameter> value)
+                     (select-job-for-commit conn value))
+                    (_ #f))))))
+
+      (let ((base-branch     (assq-ref query-parameters 'base_branch))
+            (base-datetime   (assq-ref query-parameters 'base_datetime))
+            (target-branch   (assq-ref query-parameters 'target_branch))
+            (target-datetime (assq-ref query-parameters 'target_datetime)))
+        (let* ((base-revision-details
+                (select-guix-revision-for-branch-and-datetime conn
+                                                              base-branch
+                                                              base-datetime))
+               (base-revision-id
+                (first base-revision-details))
+               (target-revision-details
+                (select-guix-revision-for-branch-and-datetime conn
+                                                              target-branch
+                                                              target-datetime))
+               (target-revision-id
+                (first target-revision-details)))
+          (let-values
+              (((base-packages-vhash target-packages-vhash)
+                (package-data->package-data-vhashes
+                 (package-differences-data conn
+                                           base-revision-id
+                                           target-revision-id))))
+            (let* ((new-packages
+                    (package-data-vhashes->new-packages base-packages-vhash
+                                                        target-packages-vhash))
+                   (removed-packages
+                    (package-data-vhashes->removed-packages base-packages-vhash
+                                                            target-packages-vhash))
+                   (version-changes
+                    (package-data-version-changes base-packages-vhash
+                                                  target-packages-vhash))
+                   (lint-warnings-data
+                    (group-list-by-first-n-fields
+                     2
+                     (lint-warning-differences-data conn
+                                                    base-revision-id
+                                                    target-revision-id))))
+              (case (most-appropriate-mime-type
+                     '(application/json text/html)
+                     mime-types)
+                ((application/json)
+                 (render-json
+                  `((new-packages . ,(list->vector new-packages))
+                    (removed-packages . ,(list->vector removed-packages))
+                    (version-changes . ,(list->vector
+                                         (map
+                                          (match-lambda
+                                            ((name data ...)
+                                             `((name . ,name)
+                                               ,@data)))
+                                          version-changes))))
+                  #:extra-headers http-headers-for-unchanging-content))
+                (else
+                 (render-html
+                  #:sxml (compare `(,@query-parameters
+                                    (base_commit . ,(second base-revision-details))
+                                    (target_commit . ,(second target-revision-details)))
+                                  (guix-revisions-cgit-url-bases
+                                   conn
+                                   (list base-revision-id
+                                         target-revision-id))
+                                  new-packages
+                                  removed-packages
+                                  version-changes
+                                  lint-warnings-data)
+                  #:extra-headers http-headers-for-unchanging-content)))))))))
+
+(define (render-compare/derivations mime-types
+                                    conn
+                                    query-parameters)
+  (define (derivations->alist derivations)
+    (map (match-lambda
+           ((file-name system target buildstatus)
+            `((file_name . ,file-name)
+              (system . ,system)
+              (target . ,target)
+              (build_status . ,(if (string=? buildstatus "")
+                                   "unknown"
+                                   buildstatus)))))
+         derivations))
+
+  (if (any-invalid-query-parameters? query-parameters)
+      (case (most-appropriate-mime-type
+             '(application/json text/html)
+             mime-types)
+        ((application/json)
+         (render-json
+          '((error . "invalid query"))))
+        (else
+         (render-html
+          #:sxml (compare/derivations
+                  query-parameters
+                  (valid-systems conn)
+                  build-status-strings
+                  '()))))
+
+      (let ((base-commit    (assq-ref query-parameters 'base_commit))
+            (target-commit  (assq-ref query-parameters 'target_commit))
+            (systems        (assq-ref query-parameters 'system))
+            (targets        (assq-ref query-parameters 'target))
+            (build-statuses (assq-ref query-parameters 'build_status)))
+        (let*
+            ((data
+              (package-differences-data conn
+                                        (commit->revision-id conn base-commit)
+                                        (commit->revision-id conn target-commit)
+                                        #:systems systems
+                                        #:targets targets))
+             (names-and-versions
+              (package-data->names-and-versions data)))
+          (let-values
+              (((base-packages-vhash target-packages-vhash)
+                (package-data->package-data-vhashes data)))
+            (let ((derivation-changes
+                   (package-data-derivation-changes names-and-versions
+                                                    base-packages-vhash
+                                                    target-packages-vhash)))
+              (case (most-appropriate-mime-type
+                     '(application/json text/html)
+                     mime-types)
+                ((application/json)
+                 (render-json
+                  derivation-changes
+                  #:extra-headers http-headers-for-unchanging-content))
+                (else
+                 (render-html
+                  #:sxml (compare/derivations
+                          query-parameters
+                          (valid-systems conn)
+                          build-status-strings
+                          derivation-changes)
+                  #:extra-headers http-headers-for-unchanging-content)))))))))
+
+(define (render-compare-by-datetime/derivations mime-types
+                                                conn
+                                                query-parameters)
+  (define (derivations->alist derivations)
+    (map (match-lambda
+           ((file-name system target buildstatus)
+            `((file_name . ,file-name)
+              (system . ,system)
+              (target . ,target)
+              (build_status . ,(if (string=? buildstatus "")
+                                   "unknown"
+                                   buildstatus)))))
+         derivations))
+
+  (if (any-invalid-query-parameters? query-parameters)
+      (case (most-appropriate-mime-type
+             '(application/json text/html)
+             mime-types)
+        ((application/json)
+         (render-json
+          '((error . "invalid query"))))
+        (else
+         (render-html
+          #:sxml (compare-by-datetime/derivations
+                  query-parameters
+                  (valid-systems conn)
+                  build-status-strings
+                  '()))))
+
+      (let ((base-branch     (assq-ref query-parameters 'base_branch))
+            (base-datetime   (assq-ref query-parameters 'base_datetime))
+            (target-branch   (assq-ref query-parameters 'target_branch))
+            (target-datetime (assq-ref query-parameters 'target_datetime))
+            (systems         (assq-ref query-parameters 'system))
+            (targets         (assq-ref query-parameters 'target))
+            (build-statuses  (assq-ref query-parameters 'build_status)))
+        (let*
+            ((base-revision-details
+              (select-guix-revision-for-branch-and-datetime conn
+                                                            base-branch
+                                                            base-datetime))
+             (target-revision-details
+              (select-guix-revision-for-branch-and-datetime conn
+                                                            target-branch
+                                                            target-datetime))
+             (data
+              (package-differences-data conn
+                                        (first base-revision-details)
+                                        (first target-revision-details)
+                                        #:systems systems
+                                        #:targets targets))
+             (names-and-versions
+              (package-data->names-and-versions data)))
+          (let-values
+              (((base-packages-vhash target-packages-vhash)
+                (package-data->package-data-vhashes data)))
+            (let ((derivation-changes
+                   (package-data-derivation-changes names-and-versions
+                                                    base-packages-vhash
+                                                    target-packages-vhash)))
+              (case (most-appropriate-mime-type
+                     '(application/json text/html)
+                     mime-types)
+                ((application/json)
+                 (render-json
+                  derivation-changes
+                  #:extra-headers http-headers-for-unchanging-content))
+                (else
+                 (render-html
+                  #:sxml (compare-by-datetime/derivations
+                          query-parameters
+                          (valid-systems conn)
+                          build-status-strings
+                          base-revision-details
+                          target-revision-details
+                          derivation-changes)
+                  #:extra-headers http-headers-for-unchanging-content)))))))))
+
+(define (render-compare/packages mime-types
+                                 conn
+                                 query-parameters)
+  (define (package-data-vhash->json vh)
+    (delete-duplicates
+     (vhash-fold (lambda (name data result)
+                   (cons `((name . ,name)
+                           (version . ,(car data)))
+                         result))
+                 '()
+                 vh)))
+
+  (if (any-invalid-query-parameters? query-parameters)
+      (case (most-appropriate-mime-type
+             '(application/json text/html)
+             mime-types)
+        ((application/json)
+         (render-json
+          '((error . "invalid query"))))
+        (else
+         (render-html
+          #:sxml (compare-invalid-parameters
+                  query-parameters
+                  (match (assq-ref query-parameters 'base_commit)
+                    (($ <invalid-query-parameter> value)
+                     (select-job-for-commit conn value))
+                    (_ #f))
+                  (match (assq-ref query-parameters 'target_commit)
+                    (($ <invalid-query-parameter> value)
+                     (select-job-for-commit conn value))
+                    (_ #f))))))
+
+      (let ((base-commit    (assq-ref query-parameters 'base_commit))
+            (target-commit  (assq-ref query-parameters 'target_commit)))
+        (let ((base-revision-id (commit->revision-id conn base-commit))
+              (target-revision-id (commit->revision-id conn target-commit)))
+
+          (let-values
+              (((base-packages-vhash target-packages-vhash)
+                (package-data->package-data-vhashes
+                 (package-differences-data conn
+                                           base-revision-id
+                                           target-revision-id))))
+            (case (most-appropriate-mime-type
+                   '(application/json text/html)
+                   mime-types)
+              ((application/json)
+               (render-json
+                `((base
+                   . ((commit . ,base-commit)
+                      (packages . ,(list->vector
+                                    (package-data-vhash->json base-packages-vhash)))))
+                  (target
+                   . ((commit . ,target-commit)
+                      (packages . ,(list->vector
+                                    (package-data-vhash->json target-packages-vhash))))))
+                #:extra-headers http-headers-for-unchanging-content))
+              (else
+               (render-html
+                #:sxml (compare/packages
+                        query-parameters
+                        base-packages-vhash
+                        target-packages-vhash)
+                #:extra-headers http-headers-for-unchanging-content))))))))
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
new file mode 100644
index 0000000..86be5a9
--- /dev/null
+++ b/guix-data-service/web/compare/html.scm
@@ -0,0 +1,661 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service web compare html)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:use-module (guix-data-service web query-parameters)
+  #:use-module (guix-data-service web view html)
+  #:export (compare
+            compare/derivations
+            compare-by-datetime/derivations
+            compare/packages
+            compare-invalid-parameters))
+
+(define (compare query-parameters
+                 cgit-url-bases
+                 new-packages
+                 removed-packages
+                 version-changes
+                 lint-warnings-data)
+  (define base-commit
+    (assq-ref query-parameters 'base_commit))
+
+  (define target-commit
+    (assq-ref query-parameters 'target_commit))
+
+  (define query-params
+    (string-append "?base_commit=" base-commit
+                   "&target_commit=" target-commit))
+
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-8"))
+        (h1 "Comparing "
+            (samp ,(string-take base-commit 8) "…")
+            " and "
+            (samp ,(string-take target-commit 8) "…"))
+        ,@(if (apply string=? cgit-url-bases)
+              `((a (@ (href ,(string-append
+                              (first cgit-url-bases)
+                              "log/?qt=range&q="
+                              base-commit ".." target-commit)))
+                   "(View cgit)"))
+              '()))
+       (div
+        (@ (class "col-sm-4"))
+        (div
+         (@ (class "btn-group-vertical btn-group-lg pull-right")
+            (style "margin-top: 2em;")
+            (role "group"))
+         (a (@ (class "btn btn-default")
+               (href ,(string-append "/compare/packages" query-params)))
+            "Compare packages")
+         (a (@ (class "btn btn-default")
+               (href ,(string-append "/compare/derivations" query-params)))
+            "Compare derivations"))))
+      (div
+       (@ (class "row") (style "clear: left;"))
+       (div
+        (@ (class "col-sm-12"))
+        (a (@ (class "btn btn-default btn-lg")
+              (href ,(string-append
+                      "/compare.json" query-params)))
+           "View JSON")))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 (@ (style "clear: both;"))
+            "New packages")
+        ,(if (null? new-packages)
+             '(p "No new packages")
+             `(table
+               (@ (class "table"))
+               (thead
+                (tr
+                 (th (@ (class "col-md-4")) "Name")
+                 (th (@ (class "col-md-4")) "Version")
+                 (th (@ (class "col-md-4")) "")))
+               (tbody
+                ,@(map
+                   (match-lambda
+                     ((('name . name)
+                       ('version . version))
+                      `(tr
+                        (td ,name)
+                        (td ,version)
+                        (td (@ (class "text-right"))
+                            (a (@ (href ,(string-append
+                                          "/revision/" target-commit
+                                          "/package/" name "/" version)))
+                               "More information")))))
+                   new-packages))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "Removed packages")
+        ,(if (null? removed-packages)
+             '(p "No removed packages")
+             `(table
+               (@ (class "table"))
+               (thead
+                (tr
+                 (th (@ (class "col-md-4")) "Name")
+                 (th (@ (class "col-md-4")) "Version")
+                 (th (@ (class "col-md-4")) "")))
+               (tbody
+                ,@(map
+                   (match-lambda
+                     ((('name . name)
+                       ('version . version))
+                      `(tr
+                        (td ,name)
+                        (td ,version)
+                        (td (@ (class "text-right"))
+                            (a (@ (href ,(string-append
+                                          "/revision/" base-commit
+                                          "/package/" name "/" version)))
+                               "More information")))))
+                   removed-packages))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "Version changes")
+        ,(if
+          (null? version-changes)
+          '(p "No version changes")
+          `(table
+            (@ (class "table"))
+            (thead
+             (tr
+              (th (@ (class "col-md-3")) "Name")
+              (th (@ (class "col-md-9")) "Versions")))
+            (tbody
+             ,@(map
+                (match-lambda
+                  ((name . versions)
+                   `(tr
+                     (td ,name)
+                     (td
+                      (ul
+                       ,@(map
+                          (match-lambda
+                            ((type . versions)
+                             `(li (@ (class ,(if (eq? type 'base)
+                                                 "text-danger"
+                                                 "text-success")))
+                                  (ul
+                                   (@ (class "list-inline")
+                                      (style "display: inline-block;"))
+                                   ,@(map
+                                      (lambda (version)
+                                        `(li (a (@ (href
+                                                    ,(string-append
+                                                      "/revision/"
+                                                      (if (eq? type 'base)
+                                                          base-commit
+                                                          target-commit)
+                                                      "/package/"
+                                                      name "/" version)))
+                                                ,version)))
+                                      (vector->list versions)))
+                                  ,(if (eq? type 'base)
+                                       " (old)"
+                                       " (new)"))))
+                          versions))))))
+                version-changes))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h2 "Lint warnings")
+        ,@(if
+           (null? lint-warnings-data)
+           '((p "No lint warning changes"))
+           (map
+            (match-lambda
+              (((package-name package-version) . warnings)
+               `((h4 ,package-name " (version: " ,package-version ")")
+                 (table
+                  (@ (class "table"))
+                  (thead
+                   (tr
+                    (th "")
+                    (th "Linter")
+                    (th "Message")))
+                  (tbody
+                   ,@(map (match-lambda
+                            ((lint-checker-name
+                              message
+                              lint-checker-description
+                              lint-checker-network-dependent
+                              file line column-number ;; TODO Maybe use the location?
+                              change)
+
+                             `(tr
+                               (td (@ (class ,(if (string=? change "new")
+                                                  "text-danger"
+                                                  "text-success"))
+                                      (style "font-weight: bold"))
+                                   ,(if (string=? change "new")
+                                        "New warning"
+                                        "Resolved warning"))
+                               (td (span (@ (style "font-family: monospace; display: block;"))
+                                         ,lint-checker-name)
+                                   (p (@ (style "font-size: small; margin: 6px 0 0px;"))
+                                      ,lint-checker-description))
+                               (td ,message))))
+                          warnings))))))
+            lint-warnings-data))))))))
+
+(define (compare/derivations query-parameters
+                             valid-systems
+                             valid-build-statuses
+                             derivation-changes)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (h1 ,@(let ((base-commit (assq-ref query-parameters 'base_commit))
+                   (target-commit (assq-ref query-parameters 'target_commit)))
+               (if (every string? (list base-commit target-commit))
+                   `("Comparing "
+                     (samp ,(string-take base-commit 8) "…")
+                     " and "
+                     (samp ,(string-take target-commit 8) "…"))
+                   '("Comparing derivations")))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-12"))
+        (div
+         (@ (class "well"))
+         (form
+          (@ (method "get")
+             (action "")
+             (class "form-horizontal"))
+          ,(form-horizontal-control
+            "Base commit" query-parameters
+            #:required? #t
+            #:help-text "The commit to use as the basis for the comparison."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Target commit" query-parameters
+            #:required? #t
+            #:help-text "The commit to compare against the base commit."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "System" query-parameters
+            #:options valid-systems
+            #:help-text "Only include derivations for this system."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Target" query-parameters
+            #:options valid-systems
+            #:help-text "Only include derivations that are build for this system."
+            #:font-family "monospace")
+          (div (@ (class "form-group form-group-lg"))
+               (div (@ (class "col-sm-offset-2 col-sm-10"))
+                    (button (@ (type "submit")
+                               (class "btn btn-lg btn-primary"))
+                            "Update results")))
+          (a (@ (class "btn btn-default btn-lg pull-right")
+                (href ,(let ((query-parameter-string
+                              (query-parameters->string query-parameters)))
+                         (string-append
+                          "/compare/derivations.json"
+                          (if (string-null? query-parameter-string)
+                              ""
+                              (string-append "?" query-parameter-string))))))
+             "View JSON")))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "Package derivation changes")
+        ,(if
+          (null? derivation-changes)
+          '(p "No derivation changes")
+          `(table
+            (@ (class "table")
+               (style "table-layout: fixed;"))
+            (thead
+             (tr
+              (th "Name")
+              (th "Version")
+              (th "System")
+              (th "Target")
+              (th (@ (class "col-xs-5")) "Derivations")))
+            (tbody
+             ,@(append-map
+                (match-lambda
+                  ((('name . name)
+                    ('version . version)
+                    ('base . base-derivations)
+                    ('target . target-derivations))
+                   (let* ((system-and-versions
+                           (delete-duplicates
+                            (append (map (lambda (details)
+                                           (cons (assq-ref details 'system)
+                                                 (assq-ref details 'target)))
+                                         (vector->list base-derivations))
+                                    (map (lambda (details)
+                                           (cons (assq-ref details 'system)
+                                                 (assq-ref details 'target)))
+                                         (vector->list target-derivations)))))
+                          (data-columns
+                           (map
+                            (match-lambda
+                              ((system . target)
+                               (let ((base-derivation-file-name
+                                      (assq-ref (find (lambda (details)
+                                                        (and (string=? (assq-ref details 'system) system)
+                                                             (string=? (assq-ref details 'target) target)))
+                                                      (vector->list base-derivations))
+                                                'derivation-file-name))
+                                     (target-derivation-file-name
+                                      (assq-ref (find (lambda (details)
+                                                        (and (string=? (assq-ref details 'system) system)
+                                                             (string=? (assq-ref details 'target) target)))
+                                                      (vector->list target-derivations))
+                                                'derivation-file-name)))
+                                 `((td (samp (@ (style "white-space: nowrap;"))
+                                             ,system))
+                                   (td (samp (@ (style "white-space: nowrap;"))
+                                             ,target))
+                                   (td ,@(if base-derivation-file-name
+                                             `((a (@ (style "display: block;")
+                                                     (href ,base-derivation-file-name))
+                                                  (span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
+                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
+                                                  ,(display-store-item-short base-derivation-file-name)))
+                                             '())
+                                       ,@(if target-derivation-file-name
+                                             `((a (@ (style "display: block; clear: left;")
+                                                     (href ,target-derivation-file-name))
+                                                  (span (@ (class "text-success glyphicon glyphicon-plus pull-left")
+                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
+                                                  ,(and=> target-derivation-file-name display-store-item-short)))
+                                             '()))))))
+                            system-and-versions)))
+
+                     `((tr (td (@ (rowspan , (length system-and-versions)))
+                               ,name)
+                           (td (@ (rowspan , (length system-and-versions)))
+                               ,version)
+                           ,@(car data-columns))
+                       ,@(map (lambda (data-row)
+                                `(tr ,data-row))
+                              (cdr data-columns))))))
+                (vector->list derivation-changes)))))))))))
+
+(define (compare-by-datetime/derivations query-parameters
+                                         valid-systems
+                                         valid-build-statuses
+                                         base-revision-details
+                                         target-revision-details
+                                         derivation-changes)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (h1 ,@(let ((base-commit (assq-ref query-parameters 'base_commit))
+                   (target-commit (assq-ref query-parameters 'target_commit)))
+               (if (every string? (list base-commit target-commit))
+                   `("Comparing "
+                     (samp ,(string-take base-commit 8) "…")
+                     " and "
+                     (samp ,(string-take target-commit 8) "…"))
+                   '("Comparing derivations")))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-12"))
+        (div
+         (@ (class "well"))
+         (form
+          (@ (method "get")
+             (action "")
+             (class "form-horizontal"))
+          ,(form-horizontal-control
+            "Base branch" query-parameters
+            #:required? #t
+            #:help-text "The branch to compare from."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Base datetime" query-parameters
+            #:required? #t
+            #:help-text "The date and time to compare from."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Target branch" query-parameters
+            #:required? #t
+            #:help-text "The branch to compare to."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Target datetime" query-parameters
+            #:required? #t
+            #:help-text "The date and time to compare to."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "System" query-parameters
+            #:options valid-systems
+            #:help-text "Only include derivations for this system."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Target" query-parameters
+            #:options valid-systems
+            #:help-text "Only include derivations that are build for this system."
+            #:font-family "monospace")
+          (div (@ (class "form-group form-group-lg"))
+               (div (@ (class "col-sm-offset-2 col-sm-10"))
+                    (button (@ (type "submit")
+                               (class "btn btn-lg btn-primary"))
+                            "Update results")))
+          (a (@ (class "btn btn-default btn-lg pull-right")
+                (href ,(let ((query-parameter-string
+                              (query-parameters->string query-parameters)))
+                         (string-append
+                          "/compare/derivations.json"
+                          (if (string-null? query-parameter-string)
+                              ""
+                              (string-append "?" query-parameter-string))))))
+             "View JSON")))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (div
+         (a (@ (href ,(string-append "/revision/" (second base-revision-details))))
+            "Base revision: " ,(second base-revision-details)))
+        (div
+         (a (@ (href ,(string-append "/revision/" (second target-revision-details))))
+            "Target revision: " ,(second target-revision-details)))
+        (h3 "Package derivation changes")
+        ,(if
+          (null? derivation-changes)
+          '(p "No derivation changes")
+          `(table
+            (@ (class "table")
+               (style "table-layout: fixed;"))
+            (thead
+             (tr
+              (th "Name")
+              (th "Version")
+              (th "System")
+              (th "Target")
+              (th (@ (class "col-xs-5")) "Derivations")))
+            (tbody
+             ,@(append-map
+                (match-lambda
+                  ((('name . name)
+                    ('version . version)
+                    ('base . base-derivations)
+                    ('target . target-derivations))
+                   (let* ((system-and-versions
+                           (delete-duplicates
+                            (append (map (lambda (details)
+                                           (cons (assq-ref details 'system)
+                                                 (assq-ref details 'target)))
+                                         (vector->list base-derivations))
+                                    (map (lambda (details)
+                                           (cons (assq-ref details 'system)
+                                                 (assq-ref details 'target)))
+                                         (vector->list target-derivations)))))
+                          (data-columns
+                           (map
+                            (match-lambda
+                              ((system . target)
+                               (let ((base-derivation-file-name
+                                      (assq-ref (find (lambda (details)
+                                                        (and (string=? (assq-ref details 'system) system)
+                                                             (string=? (assq-ref details 'target) target)))
+                                                      (vector->list base-derivations))
+                                                'derivation-file-name))
+                                     (target-derivation-file-name
+                                      (assq-ref (find (lambda (details)
+                                                        (and (string=? (assq-ref details 'system) system)
+                                                             (string=? (assq-ref details 'target) target)))
+                                                      (vector->list target-derivations))
+                                                'derivation-file-name)))
+                                 `((td (samp (@ (style "white-space: nowrap;"))
+                                             ,system))
+                                   (td (samp (@ (style "white-space: nowrap;"))
+                                             ,target))
+                                   (td ,@(if base-derivation-file-name
+                                             `((a (@ (style "display: block;")
+                                                     (href ,base-derivation-file-name))
+                                                  (span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
+                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
+                                                  ,(display-store-item-short base-derivation-file-name)))
+                                             '())
+                                       ,@(if target-derivation-file-name
+                                             `((a (@ (style "display: block; clear: left;")
+                                                     (href ,target-derivation-file-name))
+                                                  (span (@ (class "text-success glyphicon glyphicon-plus pull-left")
+                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
+                                                  ,(and=> target-derivation-file-name display-store-item-short)))
+                                             '()))))))
+                            system-and-versions)))
+
+                     `((tr (td (@ (rowspan , (length system-and-versions)))
+                               ,name)
+                           (td (@ (rowspan , (length system-and-versions)))
+                               ,version)
+                           ,@(car data-columns))
+                       ,@(map (lambda (data-row)
+                                `(tr ,data-row))
+                              (cdr data-columns))))))
+                (vector->list derivation-changes)))))))))))
+
+(define (compare/packages query-parameters
+                          base-packages-vhash
+                          target-packages-vhash)
+  (define base-commit
+    (assq-ref query-parameters 'base_commit))
+
+  (define target-commit
+    (assq-ref query-parameters 'target_commit))
+
+  (define query-params
+    (string-append "?base_commit=" base-commit
+                   "&target_commit=" target-commit))
+
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h1 "Comparing "
+            (samp ,(string-take base-commit 8) "…")
+            " and "
+            (samp ,(string-take target-commit 8) "…"))
+        (a (@ (class "btn btn-default btn-lg")
+              (href ,(string-append
+                      "/compare/packages.json" query-params)))
+           "View JSON")))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "Base ("
+            (samp ,base-commit)
+            ")")
+        (p "Packages found in the base revision.")
+        (table
+         (@ (class "table"))
+         (thead
+          (tr
+           (th (@ (class "col-md-4")) "Name")
+           (th (@ (class "col-md-4")) "Version")
+           (th (@ (class "col-md-4")) "")))
+         (tbody
+          ,@(map
+             (match-lambda
+               ((name version)
+                `(tr
+                  (td ,name)
+                  (td ,version)
+                  (td (@ (class "text-right"))
+                      (a (@ (href ,(string-append
+                                    "/revision/" base-commit
+                                    "/package/" name "/" version)))
+                         "More information")))))
+             (delete-duplicates
+              (map (lambda (data)
+                     (take data 2))
+                   (vlist->list base-packages-vhash))))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "Target ("
+            (samp ,target-commit)
+            ")")
+        (p "Packages found in the target revision.")
+        (table
+         (@ (class "table"))
+         (thead
+          (tr
+           (th (@ (class "col-md-4")) "Name")
+           (th (@ (class "col-md-4")) "Version")
+           (th (@ (class "col-md-4")) "")))
+         (tbody
+          ,@(map
+             (match-lambda
+               ((name version)
+                `(tr
+                  (td ,name)
+                  (td ,version)
+                  (td (@ (class "text-right"))
+                      (a (@ (href ,(string-append
+                                    "/revision/" target-commit
+                                    "/package/" name "/" version)))
+                         "More information")))))
+             (delete-duplicates
+              (map (lambda (data)
+                     (take data 2))
+                   (vlist->list target-packages-vhash))))))))))))
+
+(define (compare-invalid-parameters query-parameters
+                                    base-job
+                                    target-job)
+  (define base-commit
+    (assq-ref query-parameters 'base_commit))
+
+  (define target-commit
+    (peek (assq-ref query-parameters 'target_commit)))
+
+  (layout
+   #:body
+   `(,(header)
+     (div (@ (class "container"))
+          (h1 "Unknown commit")
+          ,(if (invalid-query-parameter? base-commit)
+               `(p "No known revision with commit "
+                   (strong (samp ,(invalid-query-parameter-value base-commit)))
+                   ,(if (null? base-job)
+                        " and it is not currently queued for processing"
+                        " but it is queued for processing"))
+               '())
+          ,(if (invalid-query-parameter? target-commit)
+               `(p "No known revision with commit "
+                   (strong (samp ,(invalid-query-parameter-value target-commit)))
+                   ,(if (null? target-job)
+                        " and it is not currently queued for processing"
+                        " but it is queued for processing"))
+               '())))))
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 769d2dd..b5df73b 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -53,6 +53,7 @@
   #:use-module (guix-data-service web revision controller)
   #:use-module (guix-data-service web jobs controller)
   #:use-module (guix-data-service web view html)
+  #:use-module (guix-data-service web compare controller)
   #:use-module (guix-data-service web revision controller)
   #:use-module (guix-data-service web repository controller)
   #:export (controller))
@@ -91,383 +92,6 @@
            value)))
    alist))
 
-(define (render-compare mime-types
-                        conn
-                        query-parameters)
-  (if (any-invalid-query-parameters? query-parameters)
-      (case (most-appropriate-mime-type
-             '(application/json text/html)
-             mime-types)
-        ((application/json)
-         (render-json
-          '((error . "invalid query"))))
-        (else
-         (render-html
-          #:sxml (compare-invalid-parameters
-                  query-parameters
-                  (match (assq-ref query-parameters 'base_commit)
-                    (($ <invalid-query-parameter> value)
-                     (select-job-for-commit conn value))
-                    (_ #f))
-                  (match (assq-ref query-parameters 'target_commit)
-                    (($ <invalid-query-parameter> value)
-                     (select-job-for-commit conn value))
-                    (_ #f))))))
-
-      (let ((base-revision-id (commit->revision-id
-                               conn
-                               (assq-ref query-parameters 'base_commit)))
-            (target-revision-id (commit->revision-id
-                                 conn
-                                 (assq-ref query-parameters 'target_commit))))
-        (let-values
-            (((base-packages-vhash target-packages-vhash)
-              (package-data->package-data-vhashes
-               (package-differences-data conn
-                                         base-revision-id
-                                         target-revision-id))))
-          (let* ((new-packages
-                  (package-data-vhashes->new-packages base-packages-vhash
-                                                      target-packages-vhash))
-                 (removed-packages
-                  (package-data-vhashes->removed-packages base-packages-vhash
-                                                          target-packages-vhash))
-                 (version-changes
-                  (package-data-version-changes base-packages-vhash
-                                                target-packages-vhash))
-                 (lint-warnings-data
-                  (group-list-by-first-n-fields
-                   2
-                   (lint-warning-differences-data conn
-                                                  base-revision-id
-                                                  target-revision-id))))
-            (case (most-appropriate-mime-type
-                   '(application/json text/html)
-                   mime-types)
-              ((application/json)
-               (render-json
-                `((new-packages . ,(list->vector new-packages))
-                  (removed-packages . ,(list->vector removed-packages))
-                  (version-changes . ,(list->vector
-                                       (map
-                                        (match-lambda
-                                          ((name data ...)
-                                           `((name . ,name)
-                                             ,@data)))
-                                        version-changes))))
-                #:extra-headers http-headers-for-unchanging-content))
-              (else
-               (render-html
-                #:sxml (compare query-parameters
-                                (guix-revisions-cgit-url-bases
-                                 conn
-                                 (list base-revision-id
-                                       target-revision-id))
-                                new-packages
-                                removed-packages
-                                version-changes
-                                lint-warnings-data)
-                #:extra-headers http-headers-for-unchanging-content))))))))
-
-(define (render-compare-by-datetime mime-types
-                                    conn
-                                    query-parameters)
-  (if (any-invalid-query-parameters? query-parameters)
-      (case (most-appropriate-mime-type
-             '(application/json text/html)
-             mime-types)
-        ((application/json)
-         (render-json
-          '((error . "invalid query"))))
-        (else
-         (render-html
-          #:sxml (compare-invalid-parameters
-                  query-parameters
-                  (match (assq-ref query-parameters 'base_commit)
-                    (($ <invalid-query-parameter> value)
-                     (select-job-for-commit conn value))
-                    (_ #f))
-                  (match (assq-ref query-parameters 'target_commit)
-                    (($ <invalid-query-parameter> value)
-                     (select-job-for-commit conn value))
-                    (_ #f))))))
-
-      (let ((base-branch     (assq-ref query-parameters 'base_branch))
-            (base-datetime   (assq-ref query-parameters 'base_datetime))
-            (target-branch   (assq-ref query-parameters 'target_branch))
-            (target-datetime (assq-ref query-parameters 'target_datetime)))
-        (let* ((base-revision-details
-                (select-guix-revision-for-branch-and-datetime conn
-                                                              base-branch
-                                                              base-datetime))
-               (base-revision-id
-                (first base-revision-details))
-               (target-revision-details
-                (select-guix-revision-for-branch-and-datetime conn
-                                                              target-branch
-                                                              target-datetime))
-               (target-revision-id
-                (first target-revision-details)))
-          (let-values
-              (((base-packages-vhash target-packages-vhash)
-                (package-data->package-data-vhashes
-                 (package-differences-data conn
-                                           base-revision-id
-                                           target-revision-id))))
-            (let* ((new-packages
-                    (package-data-vhashes->new-packages base-packages-vhash
-                                                        target-packages-vhash))
-                   (removed-packages
-                    (package-data-vhashes->removed-packages base-packages-vhash
-                                                            target-packages-vhash))
-                   (version-changes
-                    (package-data-version-changes base-packages-vhash
-                                                  target-packages-vhash))
-                   (lint-warnings-data
-                    (group-list-by-first-n-fields
-                     2
-                     (lint-warning-differences-data conn
-                                                    base-revision-id
-                                                    target-revision-id))))
-              (case (most-appropriate-mime-type
-                     '(application/json text/html)
-                     mime-types)
-                ((application/json)
-                 (render-json
-                  `((new-packages . ,(list->vector new-packages))
-                    (removed-packages . ,(list->vector removed-packages))
-                    (version-changes . ,(list->vector
-                                         (map
-                                          (match-lambda
-                                            ((name data ...)
-                                             `((name . ,name)
-                                               ,@data)))
-                                          version-changes))))
-                  #:extra-headers http-headers-for-unchanging-content))
-                (else
-                 (render-html
-                  #:sxml (compare `(,@query-parameters
-                                    (base_commit . ,(second base-revision-details))
-                                    (target_commit . ,(second target-revision-details)))
-                                  (guix-revisions-cgit-url-bases
-                                   conn
-                                   (list base-revision-id
-                                         target-revision-id))
-                                  new-packages
-                                  removed-packages
-                                  version-changes
-                                  lint-warnings-data)
-                  #:extra-headers http-headers-for-unchanging-content)))))))))
-
-(define (render-compare/derivations mime-types
-                                    conn
-                                    query-parameters)
-  (define (derivations->alist derivations)
-    (map (match-lambda
-           ((file-name system target buildstatus)
-            `((file_name . ,file-name)
-              (system . ,system)
-              (target . ,target)
-              (build_status . ,(if (string=? buildstatus "")
-                                   "unknown"
-                                   buildstatus)))))
-         derivations))
-
-  (if (any-invalid-query-parameters? query-parameters)
-      (case (most-appropriate-mime-type
-             '(application/json text/html)
-             mime-types)
-        ((application/json)
-         (render-json
-          '((error . "invalid query"))))
-        (else
-         (render-html
-          #:sxml (compare/derivations
-                  query-parameters
-                  (valid-systems conn)
-                  build-status-strings
-                  '()))))
-
-      (let ((base-commit    (assq-ref query-parameters 'base_commit))
-            (target-commit  (assq-ref query-parameters 'target_commit))
-            (systems        (assq-ref query-parameters 'system))
-            (targets        (assq-ref query-parameters 'target))
-            (build-statuses (assq-ref query-parameters 'build_status)))
-        (let*
-            ((data
-              (package-differences-data conn
-                                        (commit->revision-id conn base-commit)
-                                        (commit->revision-id conn target-commit)
-                                        #:systems systems
-                                        #:targets targets))
-             (names-and-versions
-              (package-data->names-and-versions data)))
-          (let-values
-              (((base-packages-vhash target-packages-vhash)
-                (package-data->package-data-vhashes data)))
-            (let ((derivation-changes
-                   (package-data-derivation-changes names-and-versions
-                                                    base-packages-vhash
-                                                    target-packages-vhash)))
-              (case (most-appropriate-mime-type
-                     '(application/json text/html)
-                     mime-types)
-                ((application/json)
-                 (render-json
-                  derivation-changes
-                  #:extra-headers http-headers-for-unchanging-content))
-                (else
-                 (render-html
-                  #:sxml (compare/derivations
-                          query-parameters
-                          (valid-systems conn)
-                          build-status-strings
-                          derivation-changes)
-                  #:extra-headers http-headers-for-unchanging-content)))))))))
-
-(define (render-compare-by-datetime/derivations mime-types
-                                                conn
-                                                query-parameters)
-  (define (derivations->alist derivations)
-    (map (match-lambda
-           ((file-name system target buildstatus)
-            `((file_name . ,file-name)
-              (system . ,system)
-              (target . ,target)
-              (build_status . ,(if (string=? buildstatus "")
-                                   "unknown"
-                                   buildstatus)))))
-         derivations))
-
-  (if (any-invalid-query-parameters? query-parameters)
-      (case (most-appropriate-mime-type
-             '(application/json text/html)
-             mime-types)
-        ((application/json)
-         (render-json
-          '((error . "invalid query"))))
-        (else
-         (render-html
-          #:sxml (compare-by-datetime/derivations
-                  query-parameters
-                  (valid-systems conn)
-                  build-status-strings
-                  '()))))
-
-      (let ((base-branch     (assq-ref query-parameters 'base_branch))
-            (base-datetime   (assq-ref query-parameters 'base_datetime))
-            (target-branch   (assq-ref query-parameters 'target_branch))
-            (target-datetime (assq-ref query-parameters 'target_datetime))
-            (systems         (assq-ref query-parameters 'system))
-            (targets         (assq-ref query-parameters 'target))
-            (build-statuses  (assq-ref query-parameters 'build_status)))
-        (let*
-            ((base-revision-details
-              (select-guix-revision-for-branch-and-datetime conn
-                                                            base-branch
-                                                            base-datetime))
-             (target-revision-details
-              (select-guix-revision-for-branch-and-datetime conn
-                                                            target-branch
-                                                            target-datetime))
-             (data
-              (package-differences-data conn
-                                        (first base-revision-details)
-                                        (first target-revision-details)
-                                        #:systems systems
-                                        #:targets targets))
-             (names-and-versions
-              (package-data->names-and-versions data)))
-          (let-values
-              (((base-packages-vhash target-packages-vhash)
-                (package-data->package-data-vhashes data)))
-            (let ((derivation-changes
-                   (package-data-derivation-changes names-and-versions
-                                                    base-packages-vhash
-                                                    target-packages-vhash)))
-              (case (most-appropriate-mime-type
-                     '(application/json text/html)
-                     mime-types)
-                ((application/json)
-                 (render-json
-                  derivation-changes
-                  #:extra-headers http-headers-for-unchanging-content))
-                (else
-                 (render-html
-                  #:sxml (compare-by-datetime/derivations
-                          query-parameters
-                          (valid-systems conn)
-                          build-status-strings
-                          base-revision-details
-                          target-revision-details
-                          derivation-changes)
-                  #:extra-headers http-headers-for-unchanging-content)))))))))
-
-(define (render-compare/packages mime-types
-                                 conn
-                                 query-parameters)
-  (define (package-data-vhash->json vh)
-    (delete-duplicates
-     (vhash-fold (lambda (name data result)
-                   (cons `((name . ,name)
-                           (version . ,(car data)))
-                         result))
-                 '()
-                 vh)))
-
-  (if (any-invalid-query-parameters? query-parameters)
-      (case (most-appropriate-mime-type
-             '(application/json text/html)
-             mime-types)
-        ((application/json)
-         (render-json
-          '((error . "invalid query"))))
-        (else
-         (render-html
-          #:sxml (compare-invalid-parameters
-                  query-parameters
-                  (match (assq-ref query-parameters 'base_commit)
-                    (($ <invalid-query-parameter> value)
-                     (select-job-for-commit conn value))
-                    (_ #f))
-                  (match (assq-ref query-parameters 'target_commit)
-                    (($ <invalid-query-parameter> value)
-                     (select-job-for-commit conn value))
-                    (_ #f))))))
-
-      (let ((base-commit    (assq-ref query-parameters 'base_commit))
-            (target-commit  (assq-ref query-parameters 'target_commit)))
-        (let ((base-revision-id (commit->revision-id conn base-commit))
-              (target-revision-id (commit->revision-id conn target-commit)))
-
-          (let-values
-              (((base-packages-vhash target-packages-vhash)
-                (package-data->package-data-vhashes
-                 (package-differences-data conn
-                                           base-revision-id
-                                           target-revision-id))))
-            (case (most-appropriate-mime-type
-                   '(application/json text/html)
-                   mime-types)
-              ((application/json)
-               (render-json
-                `((base
-                   . ((commit . ,base-commit)
-                      (packages . ,(list->vector
-                                    (package-data-vhash->json base-packages-vhash)))))
-                  (target
-                   . ((commit . ,target-commit)
-                      (packages . ,(list->vector
-                                    (package-data-vhash->json target-packages-vhash))))))
-                #:extra-headers http-headers-for-unchanging-content))
-              (else
-               (render-html
-                #:sxml (compare/packages
-                        query-parameters
-                        base-packages-vhash
-                        target-packages-vhash)
-                #:extra-headers http-headers-for-unchanging-content))))))))
-
 (define (render-derivation conn derivation-file-name)
   (let ((derivation (select-derivation-by-file-name conn
                                                     derivation-file-name)))
@@ -515,19 +139,6 @@
                                      derivations))
         #:extra-headers http-headers-for-unchanging-content)))))
 
-(define (parse-commit conn)
-  (lambda (s)
-    (if (guix-commit-exists? conn s)
-        s
-        (make-invalid-query-parameter
-         s "unknown commit"))))
-
-(define (parse-system s)
-  s)
-
-(define (parse-build-status s)
-  s)
-
 (define handle-static-assets
   (if assets-dir-in-store?
       (static-asset-from-store-renderer)
@@ -627,64 +238,8 @@
        (if (string-suffix? ".drv" path)
            (render-derivation conn path)
            (render-store-item conn path))))
-    (('GET "compare")
-     (let* ((parsed-query-parameters
-             (parse-query-parameters
-              request
-              `((base_commit   ,(parse-commit conn) #:required)
-                (target_commit ,(parse-commit conn) #:required)))))
-       (render-compare mime-types
-                       conn
-                       parsed-query-parameters)))
-    (('GET "compare-by-datetime")
-     (let* ((parsed-query-parameters
-             (parse-query-parameters
-              request
-              `((base_branch     ,identity #:required)
-                (base_datetime   ,parse-datetime #:required)
-                (target_branch   ,identity #:required)
-                (target_datetime ,parse-datetime #:required)))))
-       (render-compare-by-datetime mime-types
-                                   conn
-                                   parsed-query-parameters)))
-    (('GET "compare" "derivations")
-     (let* ((parsed-query-parameters
-             (parse-query-parameters
-              request
-              `((base_commit   ,(parse-commit conn) #:required)
-                (target_commit ,(parse-commit conn) #:required)
-                (system        ,parse-system #:multi-value)
-                (target        ,parse-system #:multi-value)
-                (build_status  ,parse-build-status #:multi-value)))))
-       (render-compare/derivations mime-types
-                                   conn
-                                   parsed-query-parameters)))
-    (('GET "compare-by-datetime" "derivations")
-     (let* ((parsed-query-parameters
-             (guard-against-mutually-exclusive-query-parameters
-              (parse-query-parameters
-               request
-               `((base_branch     ,identity #:required)
-                 (base_datetime   ,parse-datetime #:required)
-                 (target_branch   ,identity #:required)
-                 (target_datetime ,parse-datetime #:required)
-                 (system          ,parse-system #:multi-value)
-                 (target          ,parse-system #:multi-value)
-                 (build_status    ,parse-build-status #:multi-value)))
-              '((base_commit base_datetime)
-                (target_commit target_datetime)))))
-       (render-compare-by-datetime/derivations mime-types
-                                               conn
-                                               parsed-query-parameters)))
-    (('GET "compare" "packages")
-     (let* ((parsed-query-parameters
-             (parse-query-parameters
-              request
-              `((base_commit   ,(parse-commit conn) #:required)
-                (target_commit ,(parse-commit conn) #:required)))))
-       (render-compare/packages mime-types
-                                conn
-                                parsed-query-parameters)))
+    (('GET "compare" _ ...)             (delegate-to compare-controller))
+    (('GET "compare-by-datetime" _ ...) (delegate-to compare-controller))
     (('GET "jobs")         (delegate-to jobs-controller))
     (('GET "jobs" "queue") (delegate-to jobs-controller))
     (('GET "job" job-id)   (delegate-to jobs-controller))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 0972063..ae9fe0e 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -44,11 +44,6 @@
             view-builds
             view-derivation
             view-store-item
-            compare
-            compare/derivations
-            compare-by-datetime/derivations
-            compare/packages
-            compare-invalid-parameters
             error-page))
 
 (define* (header)
@@ -581,610 +576,6 @@
                              ,(display-store-item-short path))))))
                  derivation-outputs)))))))))
 
-(define (compare query-parameters
-                 cgit-url-bases
-                 new-packages
-                 removed-packages
-                 version-changes
-                 lint-warnings-data)
-  (define base-commit
-    (assq-ref query-parameters 'base_commit))
-
-  (define target-commit
-    (assq-ref query-parameters 'target_commit))
-
-  (define query-params
-    (string-append "?base_commit=" base-commit
-                   "&target_commit=" target-commit))
-
-  (layout
-   #:body
-   `(,(header)
-     (div
-      (@ (class "container"))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-8"))
-        (h1 "Comparing "
-            (samp ,(string-take base-commit 8) "…")
-            " and "
-            (samp ,(string-take target-commit 8) "…"))
-        ,@(if (apply string=? cgit-url-bases)
-              `((a (@ (href ,(string-append
-                              (first cgit-url-bases)
-                              "log/?qt=range&q="
-                              base-commit ".." target-commit)))
-                   "(View cgit)"))
-              '()))
-       (div
-        (@ (class "col-sm-4"))
-        (div
-         (@ (class "btn-group-vertical btn-group-lg pull-right")
-            (style "margin-top: 2em;")
-            (role "group"))
-         (a (@ (class "btn btn-default")
-               (href ,(string-append "/compare/packages" query-params)))
-            "Compare packages")
-         (a (@ (class "btn btn-default")
-               (href ,(string-append "/compare/derivations" query-params)))
-            "Compare derivations"))))
-      (div
-       (@ (class "row") (style "clear: left;"))
-       (div
-        (@ (class "col-sm-12"))
-        (a (@ (class "btn btn-default btn-lg")
-              (href ,(string-append
-                      "/compare.json" query-params)))
-           "View JSON")))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h3 (@ (style "clear: both;"))
-            "New packages")
-        ,(if (null? new-packages)
-             '(p "No new packages")
-             `(table
-               (@ (class "table"))
-               (thead
-                (tr
-                 (th (@ (class "col-md-4")) "Name")
-                 (th (@ (class "col-md-4")) "Version")
-                 (th (@ (class "col-md-4")) "")))
-               (tbody
-                ,@(map
-                   (match-lambda
-                     ((('name . name)
-                       ('version . version))
-                      `(tr
-                        (td ,name)
-                        (td ,version)
-                        (td (@ (class "text-right"))
-                            (a (@ (href ,(string-append
-                                          "/revision/" target-commit
-                                          "/package/" name "/" version)))
-                               "More information")))))
-                   new-packages))))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h3 "Removed packages")
-        ,(if (null? removed-packages)
-             '(p "No removed packages")
-             `(table
-               (@ (class "table"))
-               (thead
-                (tr
-                 (th (@ (class "col-md-4")) "Name")
-                 (th (@ (class "col-md-4")) "Version")
-                 (th (@ (class "col-md-4")) "")))
-               (tbody
-                ,@(map
-                   (match-lambda
-                     ((('name . name)
-                       ('version . version))
-                      `(tr
-                        (td ,name)
-                        (td ,version)
-                        (td (@ (class "text-right"))
-                            (a (@ (href ,(string-append
-                                          "/revision/" base-commit
-                                          "/package/" name "/" version)))
-                               "More information")))))
-                   removed-packages))))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h3 "Version changes")
-        ,(if
-          (null? version-changes)
-          '(p "No version changes")
-          `(table
-            (@ (class "table"))
-            (thead
-             (tr
-              (th (@ (class "col-md-3")) "Name")
-              (th (@ (class "col-md-9")) "Versions")))
-            (tbody
-             ,@(map
-                (match-lambda
-                  ((name . versions)
-                   `(tr
-                     (td ,name)
-                     (td
-                      (ul
-                       ,@(map
-                          (match-lambda
-                            ((type . versions)
-                             `(li (@ (class ,(if (eq? type 'base)
-                                                 "text-danger"
-                                                 "text-success")))
-                                  (ul
-                                   (@ (class "list-inline")
-                                      (style "display: inline-block;"))
-                                   ,@(map
-                                      (lambda (version)
-                                        `(li (a (@ (href
-                                                    ,(string-append
-                                                      "/revision/"
-                                                      (if (eq? type 'base)
-                                                          base-commit
-                                                          target-commit)
-                                                      "/package/"
-                                                      name "/" version)))
-                                                ,version)))
-                                      (vector->list versions)))
-                                  ,(if (eq? type 'base)
-                                       " (old)"
-                                       " (new)"))))
-                          versions))))))
-                version-changes))))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h2 "Lint warnings")
-        ,@(if
-           (null? lint-warnings-data)
-           '((p "No lint warning changes"))
-           (map
-            (match-lambda
-              (((package-name package-version) . warnings)
-               `((h4 ,package-name " (version: " ,package-version ")")
-                 (table
-                  (@ (class "table"))
-                  (thead
-                   (tr
-                    (th "")
-                    (th "Linter")
-                    (th "Message")))
-                  (tbody
-                   ,@(map (match-lambda
-                            ((lint-checker-name
-                              message
-                              lint-checker-description
-                              lint-checker-network-dependent
-                              file line column-number ;; TODO Maybe use the location?
-                              change)
-
-                             `(tr
-                               (td (@ (class ,(if (string=? change "new")
-                                                  "text-danger"
-                                                  "text-success"))
-                                      (style "font-weight: bold"))
-                                   ,(if (string=? change "new")
-                                        "New warning"
-                                        "Resolved warning"))
-                               (td (span (@ (style "font-family: monospace; display: block;"))
-                                         ,lint-checker-name)
-                                   (p (@ (style "font-size: small; margin: 6px 0 0px;"))
-                                      ,lint-checker-description))
-                               (td ,message))))
-                          warnings))))))
-            lint-warnings-data))))))))
-
-(define (compare/derivations query-parameters
-                             valid-systems
-                             valid-build-statuses
-                             derivation-changes)
-  (layout
-   #:body
-   `(,(header)
-     (div
-      (@ (class "container"))
-      (div
-       (@ (class "row"))
-       (h1 ,@(let ((base-commit (assq-ref query-parameters 'base_commit))
-                   (target-commit (assq-ref query-parameters 'target_commit)))
-               (if (every string? (list base-commit target-commit))
-                   `("Comparing "
-                     (samp ,(string-take base-commit 8) "…")
-                     " and "
-                     (samp ,(string-take target-commit 8) "…"))
-                   '("Comparing derivations")))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-md-12"))
-        (div
-         (@ (class "well"))
-         (form
-          (@ (method "get")
-             (action "")
-             (class "form-horizontal"))
-          ,(form-horizontal-control
-            "Base commit" query-parameters
-            #:required? #t
-            #:help-text "The commit to use as the basis for the comparison."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "Target commit" query-parameters
-            #:required? #t
-            #:help-text "The commit to compare against the base commit."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "System" query-parameters
-            #:options valid-systems
-            #:help-text "Only include derivations for this system."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "Target" query-parameters
-            #:options valid-systems
-            #:help-text "Only include derivations that are build for this system."
-            #:font-family "monospace")
-          (div (@ (class "form-group form-group-lg"))
-               (div (@ (class "col-sm-offset-2 col-sm-10"))
-                    (button (@ (type "submit")
-                               (class "btn btn-lg btn-primary"))
-                            "Update results")))
-          (a (@ (class "btn btn-default btn-lg pull-right")
-                (href ,(let ((query-parameter-string
-                              (query-parameters->string query-parameters)))
-                         (string-append
-                          "/compare/derivations.json"
-                          (if (string-null? query-parameter-string)
-                              ""
-                              (string-append "?" query-parameter-string))))))
-             "View JSON")))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h3 "Package derivation changes")
-        ,(if
-          (null? derivation-changes)
-          '(p "No derivation changes")
-          `(table
-            (@ (class "table")
-               (style "table-layout: fixed;"))
-            (thead
-             (tr
-              (th "Name")
-              (th "Version")
-              (th "System")
-              (th "Target")
-              (th (@ (class "col-xs-5")) "Derivations")))
-            (tbody
-             ,@(append-map
-                (match-lambda
-                  ((('name . name)
-                    ('version . version)
-                    ('base . base-derivations)
-                    ('target . target-derivations))
-                   (let* ((system-and-versions
-                           (delete-duplicates
-                            (append (map (lambda (details)
-                                           (cons (assq-ref details 'system)
-                                                 (assq-ref details 'target)))
-                                         (vector->list base-derivations))
-                                    (map (lambda (details)
-                                           (cons (assq-ref details 'system)
-                                                 (assq-ref details 'target)))
-                                         (vector->list target-derivations)))))
-                          (data-columns
-                           (map
-                            (match-lambda
-                              ((system . target)
-                               (let ((base-derivation-file-name
-                                      (assq-ref (find (lambda (details)
-                                                        (and (string=? (assq-ref details 'system) system)
-                                                             (string=? (assq-ref details 'target) target)))
-                                                      (vector->list base-derivations))
-                                                'derivation-file-name))
-                                     (target-derivation-file-name
-                                      (assq-ref (find (lambda (details)
-                                                        (and (string=? (assq-ref details 'system) system)
-                                                             (string=? (assq-ref details 'target) target)))
-                                                      (vector->list target-derivations))
-                                                'derivation-file-name)))
-                                 `((td (samp (@ (style "white-space: nowrap;"))
-                                             ,system))
-                                   (td (samp (@ (style "white-space: nowrap;"))
-                                             ,target))
-                                   (td ,@(if base-derivation-file-name
-                                             `((a (@ (style "display: block;")
-                                                     (href ,base-derivation-file-name))
-                                                  (span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
-                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
-                                                  ,(display-store-item-short base-derivation-file-name)))
-                                             '())
-                                       ,@(if target-derivation-file-name
-                                             `((a (@ (style "display: block; clear: left;")
-                                                     (href ,target-derivation-file-name))
-                                                  (span (@ (class "text-success glyphicon glyphicon-plus pull-left")
-                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
-                                                  ,(and=> target-derivation-file-name display-store-item-short)))
-                                             '()))))))
-                            system-and-versions)))
-
-                     `((tr (td (@ (rowspan , (length system-and-versions)))
-                               ,name)
-                           (td (@ (rowspan , (length system-and-versions)))
-                               ,version)
-                           ,@(car data-columns))
-                       ,@(map (lambda (data-row)
-                                `(tr ,data-row))
-                              (cdr data-columns))))))
-                (vector->list derivation-changes)))))))))))
-
-(define (compare-by-datetime/derivations query-parameters
-                                         valid-systems
-                                         valid-build-statuses
-                                         base-revision-details
-                                         target-revision-details
-                                         derivation-changes)
-  (layout
-   #:body
-   `(,(header)
-     (div
-      (@ (class "container"))
-      (div
-       (@ (class "row"))
-       (h1 ,@(let ((base-commit (assq-ref query-parameters 'base_commit))
-                   (target-commit (assq-ref query-parameters 'target_commit)))
-               (if (every string? (list base-commit target-commit))
-                   `("Comparing "
-                     (samp ,(string-take base-commit 8) "…")
-                     " and "
-                     (samp ,(string-take target-commit 8) "…"))
-                   '("Comparing derivations")))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-md-12"))
-        (div
-         (@ (class "well"))
-         (form
-          (@ (method "get")
-             (action "")
-             (class "form-horizontal"))
-          ,(form-horizontal-control
-            "Base branch" query-parameters
-            #:required? #t
-            #:help-text "The branch to compare from."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "Base datetime" query-parameters
-            #:required? #t
-            #:help-text "The date and time to compare from."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "Target branch" query-parameters
-            #:required? #t
-            #:help-text "The branch to compare to."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "Target datetime" query-parameters
-            #:required? #t
-            #:help-text "The date and time to compare to."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "System" query-parameters
-            #:options valid-systems
-            #:help-text "Only include derivations for this system."
-            #:font-family "monospace")
-          ,(form-horizontal-control
-            "Target" query-parameters
-            #:options valid-systems
-            #:help-text "Only include derivations that are build for this system."
-            #:font-family "monospace")
-          (div (@ (class "form-group form-group-lg"))
-               (div (@ (class "col-sm-offset-2 col-sm-10"))
-                    (button (@ (type "submit")
-                               (class "btn btn-lg btn-primary"))
-                            "Update results")))
-          (a (@ (class "btn btn-default btn-lg pull-right")
-                (href ,(let ((query-parameter-string
-                              (query-parameters->string query-parameters)))
-                         (string-append
-                          "/compare/derivations.json"
-                          (if (string-null? query-parameter-string)
-                              ""
-                              (string-append "?" query-parameter-string))))))
-             "View JSON")))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (div
-         (a (@ (href ,(string-append "/revision/" (second base-revision-details))))
-            "Base revision: " ,(second base-revision-details)))
-        (div
-         (a (@ (href ,(string-append "/revision/" (second target-revision-details))))
-            "Target revision: " ,(second target-revision-details)))
-        (h3 "Package derivation changes")
-        ,(if
-          (null? derivation-changes)
-          '(p "No derivation changes")
-          `(table
-            (@ (class "table")
-               (style "table-layout: fixed;"))
-            (thead
-             (tr
-              (th "Name")
-              (th "Version")
-              (th "System")
-              (th "Target")
-              (th (@ (class "col-xs-5")) "Derivations")))
-            (tbody
-             ,@(append-map
-                (match-lambda
-                  ((('name . name)
-                    ('version . version)
-                    ('base . base-derivations)
-                    ('target . target-derivations))
-                   (let* ((system-and-versions
-                           (delete-duplicates
-                            (append (map (lambda (details)
-                                           (cons (assq-ref details 'system)
-                                                 (assq-ref details 'target)))
-                                         (vector->list base-derivations))
-                                    (map (lambda (details)
-                                           (cons (assq-ref details 'system)
-                                                 (assq-ref details 'target)))
-                                         (vector->list target-derivations)))))
-                          (data-columns
-                           (map
-                            (match-lambda
-                              ((system . target)
-                               (let ((base-derivation-file-name
-                                      (assq-ref (find (lambda (details)
-                                                        (and (string=? (assq-ref details 'system) system)
-                                                             (string=? (assq-ref details 'target) target)))
-                                                      (vector->list base-derivations))
-                                                'derivation-file-name))
-                                     (target-derivation-file-name
-                                      (assq-ref (find (lambda (details)
-                                                        (and (string=? (assq-ref details 'system) system)
-                                                             (string=? (assq-ref details 'target) target)))
-                                                      (vector->list target-derivations))
-                                                'derivation-file-name)))
-                                 `((td (samp (@ (style "white-space: nowrap;"))
-                                             ,system))
-                                   (td (samp (@ (style "white-space: nowrap;"))
-                                             ,target))
-                                   (td ,@(if base-derivation-file-name
-                                             `((a (@ (style "display: block;")
-                                                     (href ,base-derivation-file-name))
-                                                  (span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
-                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
-                                                  ,(display-store-item-short base-derivation-file-name)))
-                                             '())
-                                       ,@(if target-derivation-file-name
-                                             `((a (@ (style "display: block; clear: left;")
-                                                     (href ,target-derivation-file-name))
-                                                  (span (@ (class "text-success glyphicon glyphicon-plus pull-left")
-                                                           (style "font-size: 1.5em; padding-right: 0.4em;")))
-                                                  ,(and=> target-derivation-file-name display-store-item-short)))
-                                             '()))))))
-                            system-and-versions)))
-
-                     `((tr (td (@ (rowspan , (length system-and-versions)))
-                               ,name)
-                           (td (@ (rowspan , (length system-and-versions)))
-                               ,version)
-                           ,@(car data-columns))
-                       ,@(map (lambda (data-row)
-                                `(tr ,data-row))
-                              (cdr data-columns))))))
-                (vector->list derivation-changes)))))))))))
-
-(define (compare/packages query-parameters
-                          base-packages-vhash
-                          target-packages-vhash)
-  (define base-commit
-    (assq-ref query-parameters 'base_commit))
-
-  (define target-commit
-    (assq-ref query-parameters 'target_commit))
-
-  (define query-params
-    (string-append "?base_commit=" base-commit
-                   "&target_commit=" target-commit))
-
-  (layout
-   #:body
-   `(,(header)
-     (div
-      (@ (class "container"))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h1 "Comparing "
-            (samp ,(string-take base-commit 8) "…")
-            " and "
-            (samp ,(string-take target-commit 8) "…"))
-        (a (@ (class "btn btn-default btn-lg")
-              (href ,(string-append
-                      "/compare/packages.json" query-params)))
-           "View JSON")))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h3 "Base ("
-            (samp ,base-commit)
-            ")")
-        (p "Packages found in the base revision.")
-        (table
-         (@ (class "table"))
-         (thead
-          (tr
-           (th (@ (class "col-md-4")) "Name")
-           (th (@ (class "col-md-4")) "Version")
-           (th (@ (class "col-md-4")) "")))
-         (tbody
-          ,@(map
-             (match-lambda
-               ((name version)
-                `(tr
-                  (td ,name)
-                  (td ,version)
-                  (td (@ (class "text-right"))
-                      (a (@ (href ,(string-append
-                                    "/revision/" base-commit
-                                    "/package/" name "/" version)))
-                         "More information")))))
-             (delete-duplicates
-              (map (lambda (data)
-                     (take data 2))
-                   (vlist->list base-packages-vhash))))))))
-      (div
-       (@ (class "row"))
-       (div
-        (@ (class "col-sm-12"))
-        (h3 "Target ("
-            (samp ,target-commit)
-            ")")
-        (p "Packages found in the target revision.")
-        (table
-         (@ (class "table"))
-         (thead
-          (tr
-           (th (@ (class "col-md-4")) "Name")
-           (th (@ (class "col-md-4")) "Version")
-           (th (@ (class "col-md-4")) "")))
-         (tbody
-          ,@(map
-             (match-lambda
-               ((name version)
-                `(tr
-                  (td ,name)
-                  (td ,version)
-                  (td (@ (class "text-right"))
-                      (a (@ (href ,(string-append
-                                    "/revision/" target-commit
-                                    "/package/" name "/" version)))
-                         "More information")))))
-             (delete-duplicates
-              (map (lambda (data)
-                     (take data 2))
-                   (vlist->list target-packages-vhash))))))))))))
-
 (define (general-not-found header-text body)
   (layout
    #:body
@@ -1194,35 +585,6 @@
       (h1 ,header-text)
       (p ,body)))))
 
-(define (compare-invalid-parameters query-parameters
-                                    base-job
-                                    target-job)
-  (define base-commit
-    (assq-ref query-parameters 'base_commit))
-
-  (define target-commit
-    (peek (assq-ref query-parameters 'target_commit)))
-
-  (layout
-   #:body
-   `(,(header)
-     (div (@ (class "container"))
-          (h1 "Unknown commit")
-          ,(if (invalid-query-parameter? base-commit)
-               `(p "No known revision with commit "
-                   (strong (samp ,(invalid-query-parameter-value base-commit)))
-                   ,(if (null? base-job)
-                        " and it is not currently queued for processing"
-                        " but it is queued for processing"))
-               '())
-          ,(if (invalid-query-parameter? target-commit)
-               `(p "No known revision with commit "
-                   (strong (samp ,(invalid-query-parameter-value target-commit)))
-                   ,(if (null? target-job)
-                        " and it is not currently queued for processing"
-                        " but it is queued for processing"))
-               '())))))
-
 (define (error-page message)
   (layout
    #:body