1 files changed, 59 insertions, 0 deletions
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
index 86be5a9..2055a8d 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -22,6 +22,7 @@
   #:use-module (guix-data-service web query-parameters)
   #:use-module (guix-data-service web view html)
   #:export (compare
+            compare/derivation
             compare/derivations
             compare-by-datetime/derivations
             compare/packages
@@ -232,6 +233,64 @@
                           warnings))))))
             lint-warnings-data))))))))
 
+(define (compare/derivation query-parameters data)
+  (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 derivation" query-parameters
+            #:required? #t
+            #:help-text "The derivation to use as the basis for the comparison."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Target derivation" query-parameters
+            #:required? #t
+            #:help-text "The derivation to compare against the base commit."
+            #: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/derivation.json"
+                          (if (string-null? query-parameter-string)
+                              ""
+                              (string-append "?" query-parameter-string))))))
+             "View JSON")))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "Foo")
+        ,@(let ((inputs (assq-ref data 'inputs)))
+            (assq-ref inputs 'target))))))))
+
 (define (compare/derivations query-parameters
                              valid-systems
                              valid-build-statuses