Improve the failed comparison page

2 files changed, 59 insertions, 46 deletions

diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index 2a55d56..9db338d 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -149,33 +149,35 @@
 (define (render-compare mime-types
                         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
-         (letpar& ((base-job
-                    (match (assq-ref query-parameters 'base_commit)
-                      (($ <invalid-query-parameter> value)
-                       (with-thread-postgresql-connection
-                        (lambda (conn)
-                          (select-job-for-commit conn value))))
-                      (_ #f)))
-                   (target-job
-                    (match (assq-ref query-parameters 'target_commit)
-                      (($ <invalid-query-parameter> value)
-                       (with-thread-postgresql-connection
-                        (lambda (conn)
-                          (select-job-for-commit conn value))))
-                      (_ #f))))
+      (letpar& ((base-job
+                 (match (assq-ref query-parameters 'base_commit)
+                   (($ <invalid-query-parameter> value)
+                    (with-thread-postgresql-connection
+                     (lambda (conn)
+                       (select-job-for-commit conn value))))
+                   (_ #f)))
+                (target-job
+                 (match (assq-ref query-parameters 'target_commit)
+                   (($ <invalid-query-parameter> value)
+                    (with-thread-postgresql-connection
+                     (lambda (conn)
+                       (select-job-for-commit conn value))))
+                   (_ #f))))
+        (case (most-appropriate-mime-type
+               '(application/json text/html)
+               mime-types)
+          ((application/json)
+           (peek target-job)
+           (render-json
+            `((error      . "invalid query")
+              (base_job   . ,base-job)
+              (target_job . ,target-job))))
+          (else
            (render-html
             #:sxml (compare-invalid-parameters
                     query-parameters
                     base-job
                     target-job)))))
-
       (letpar& ((base-revision-id
                  (with-thread-postgresql-connection
                   (lambda (conn)
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
index ac88d07..97dce70 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -1028,32 +1028,43 @@
   (define target-commit
     (assq-ref query-parameters 'target_commit))
 
+  (define (description-for-state state)
+    (cond
+     ((string=? state "queued")
+      " is queued for processing.")
+     ((string=? state "failed")
+      " has failed.")
+     ((string=? state "succeeded")
+      " has succeeded.")))
+
   (layout
    #:body
    `(,(header)
      (div (@ (class "container"))
           (h1 "Unknown commit")
-          ,(if (invalid-query-parameter? base-commit)
-               (if base-job
-                   `(p "Revision "
-                     (a (@ (href
-                            ,(string-append "/revision/"
-                                            (invalid-query-parameter-value base-commit))))
-                        (strong (samp ,(invalid-query-parameter-value base-commit))))
-                     " is queued for processing.")
-                   `(p "No known revision with commit "
-                       (strong (samp ,(invalid-query-parameter-value base-commit)))
-                       "."))
-               '())
-          ,(if (invalid-query-parameter? target-commit)
-               (if target-job
-                   `(p "Revision "
-                       (a (@ (href
-                              ,(string-append "/revision/"
-                                              (invalid-query-parameter-value target-commit))))
-                          (strong (samp ,(invalid-query-parameter-value target-commit))))
-                       " is queued for processing.")
-                   `(p "No known revision with commit "
-                       (strong (samp ,(invalid-query-parameter-value target-commit)))
-                       "."))
-               '())))))
+          ,(if (peek "BASE" base-job)
+               `(p "Revision "
+                   (a (@ (href
+                          ,(string-append
+                            "/revision/"
+                            (invalid-query-parameter-value base-commit))))
+                      (strong (samp ,(invalid-query-parameter-value
+                                      base-commit))))
+                   ,(description-for-state
+                     (assq-ref base-job 'state)))
+               `(p "No known revision with commit "
+                   (strong (samp ,base-commit))
+                   "."))
+          ,(if target-job
+               `(p "Revision "
+                   (a (@ (href
+                          ,(string-append
+                            "/revision/"
+                            (invalid-query-parameter-value target-commit))))
+                      (strong (samp ,(invalid-query-parameter-value
+                                      target-commit))))
+                   ,(description-for-state
+                     (assq-ref target-job 'state)))
+               `(p "No known revision with commit "
+                   (strong (samp ,target-commit))
+                   "."))))))