From c333aec0c39190b6c81f2fcb80b6aa3f7a6ed152 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 1 Dec 2019 21:31:29 +0000
Subject: Support querying builds by status

---
 guix-data-service/model/build.scm          | 15 ++++++++++---
 guix-data-service/web/build/controller.scm | 35 +++++++++++++++++++++++++-----
 guix-data-service/web/build/html.scm       | 25 ++++++++++++++++++++-
 guix-data-service/web/view/html.scm        |  1 +
 4 files changed, 67 insertions(+), 9 deletions(-)

diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm
index 2e3385a..ef6b167 100644
--- a/guix-data-service/model/build.scm
+++ b/guix-data-service/model/build.scm
@@ -28,9 +28,9 @@ ORDER BY status")
 
   (exec-query conn query))
 
-(define (select-builds-with-context conn)
+(define (select-builds-with-context conn build-statuses)
   (define query
-    "
+    (string-append "
 SELECT builds.id, build_servers.url, derivations.file_name,
        latest_build_status.timestamp, latest_build_status.status
 FROM builds
@@ -43,8 +43,17 @@ INNER JOIN
   ORDER BY build_id, timestamp DESC
 ) AS latest_build_status
 ON latest_build_status.build_id = builds.id
+"
+    (if (list? build-statuses)
+        (string-append
+         "WHERE latest_build_status.status IN ("
+         (string-join (map quote-string build-statuses)
+                      ",")
+         ")")
+        "")
+    "
 ORDER BY latest_build_status.timestamp DESC
-LIMIT 100")
+LIMIT 100"))
 
   (exec-query conn query))
 
diff --git a/guix-data-service/web/build/controller.scm b/guix-data-service/web/build/controller.scm
index 413f381..df08e3c 100644
--- a/guix-data-service/web/build/controller.scm
+++ b/guix-data-service/web/build/controller.scm
@@ -20,9 +20,18 @@
   #:use-module (guix-data-service web render)
   #:use-module (guix-data-service web query-parameters)
   #:use-module (guix-data-service model build)
+  #:use-module (guix-data-service model build-status)
   #:use-module (guix-data-service web build html)
   #:export (build-controller))
 
+(define (parse-build-status status)
+  (if (member status build-status-strings)
+      status
+      (make-invalid-query-parameter
+       status
+       (string-append "unknown build status: "
+                      status))))
+
 (define (build-controller request
                           method-and-path-components
                           mime-types
@@ -30,11 +39,27 @@
                           conn)
   (match method-and-path-components
     (('GET "builds")
-     (render-builds mime-types
+     (render-builds request
+                    mime-types
                     conn))
     (_ #f)))
 
-(define (render-builds mime-types conn)
-  (render-html
-   #:sxml (view-builds (select-build-stats conn)
-                       (select-builds-with-context conn))))
+(define (render-builds request mime-types conn)
+  (let ((parsed-query-parameters
+         (parse-query-parameters
+          request
+          `((build_status ,parse-build-status #:multi-value)))))
+    (if (any-invalid-query-parameters? parsed-query-parameters)
+        (render-html
+         #:sxml (view-builds parsed-query-parameters
+                             build-status-strings
+                             '()
+                             '()))
+        (render-html
+         #:sxml (view-builds parsed-query-parameters
+                             build-status-strings
+                             (select-build-stats conn)
+                             (select-builds-with-context
+                              conn
+                              (assq-ref parsed-query-parameters
+                                        'build_status)))))))
diff --git a/guix-data-service/web/build/html.scm b/guix-data-service/web/build/html.scm
index 61382aa..65c4e66 100644
--- a/guix-data-service/web/build/html.scm
+++ b/guix-data-service/web/build/html.scm
@@ -21,7 +21,7 @@
   #:use-module (guix-data-service web view html)
   #:export (view-builds))
 
-(define (view-builds stats builds)
+(define (view-builds query-parameters build-status-strings stats builds)
   (layout
    #:body
    `(,(header)
@@ -46,6 +46,29 @@
                   (td ,(build-status-span status))
                   (td ,count))))
              stats)))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-12"))
+        (div
+         (@ (class "well"))
+         (form
+          (@ (method "get")
+             (action "")
+             (class "form-horizontal"))
+          ,(form-horizontal-control
+            "Build status" query-parameters
+            #:options
+            (map (lambda (build-status)
+                   (cons (build-status-value->display-string build-status)
+                         build-status))
+                 build-status-strings)
+            #:help-text "Return builds with these statuses.")
+          (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")))))))
       (div
        (@ (class "row"))
        (div
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 1417505..e3afb08 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -35,6 +35,7 @@
             display-possible-store-item
             display-store-item
             display-store-item-short
+            build-status-value->display-string
             build-status-span
 
             table/branches-with-most-recent-commits
-- 
cgit v1.2.3