Support more query parameters on the /builds page

2 files changed, 76 insertions, 33 deletions

diff --git a/guix-data-service/web/build/controller.scm b/guix-data-service/web/build/controller.scm
index 731ba11..a70e10d 100644
--- a/guix-data-service/web/build/controller.scm
+++ b/guix-data-service/web/build/controller.scm
@@ -25,6 +25,7 @@
   #:use-module (guix-data-service model build)
   #:use-module (guix-data-service model build-status)
   #:use-module (guix-data-service model build-server)
+  #:use-module (guix-data-service model derivation)
   #:use-module (guix-data-service web build html)
   #:export (build-controller))
 
@@ -66,44 +67,65 @@
   (let ((parsed-query-parameters
          (parse-query-parameters
           request
-          `((build_status ,parse-build-status #:multi-value)
-            (build_server ,parse-build-server #:multi-value)))))
+          `((build_status  ,parse-build-status #:multi-value)
+            (build_server  ,parse-build-server #:multi-value)
+            (system        ,parse-system #:default "x86_64-linux")
+            (target        ,parse-target #:default "")
+            (limit_results ,parse-result-limit
+                           #:no-default-when (all_results)
+                           #:default 50)
+            (all_results   ,parse-checkbox-value)))))
     (if (any-invalid-query-parameters? parsed-query-parameters)
         (render-html
          #:sxml (view-builds parsed-query-parameters
                              build-status-strings
                              '()
                              '()
+                             '()
+                             '()
                              '()))
-        (letpar& ((build-server-options
-                   (with-thread-postgresql-connection
-                    (lambda (conn)
-                      (map (match-lambda
-                             ((id url lookup-all-derivations
-                                  lookup-builds)
-                              (cons url id)))
-                           (select-build-servers conn)))))
-                  (build-stats
-                   (with-thread-postgresql-connection
-                    (lambda (conn)
-                      (select-build-stats
-                       conn
-                       (assq-ref parsed-query-parameters
-                                 'build_server)))))
-                  (builds-with-context
-                   (with-thread-postgresql-connection
-                    (lambda (conn)
-                      (select-builds-with-context
-                       conn
-                       (assq-ref parsed-query-parameters
-                                 'build_status)
-                       (assq-ref parsed-query-parameters
-                                 'build_server)
-                       #:limit 50)))))
+        (let ((system (assq-ref parsed-query-parameters 'system))
+              (target (assq-ref parsed-query-parameters 'target)))
+          (letpar& ((build-server-options
+                     (with-thread-postgresql-connection
+                      (lambda (conn)
+                        (map (match-lambda
+                               ((id url lookup-all-derivations
+                                    lookup-builds)
+                                (cons url id)))
+                             (select-build-servers conn)))))
+                    (build-stats
+                     (with-thread-postgresql-connection
+                      (lambda (conn)
+                        (select-build-stats
+                         conn
+                         (assq-ref parsed-query-parameters
+                                   'build_server)
+                         #:system system
+                         #:target target))))
+                    (builds-with-context
+                     (with-thread-postgresql-connection
+                      (lambda (conn)
+                        (select-builds-with-context
+                         conn
+                         (assq-ref parsed-query-parameters
+                                   'build_status)
+                         (assq-ref parsed-query-parameters
+                                   'build_server)
+                         #:system system
+                         #:target target
+                         #:limit (assq-ref parsed-query-parameters
+                                           'limit_results)))))
+                    (systems
+                     (with-thread-postgresql-connection valid-systems))
+                    (targets
+                     (with-thread-postgresql-connection valid-targets)))
 
-          (render-html
-           #:sxml (view-builds parsed-query-parameters
-                               build-status-strings
-                               build-server-options
-                               build-stats
-                               builds-with-context))))))
+            (render-html
+             #:sxml (view-builds parsed-query-parameters
+                                 build-status-strings
+                                 build-server-options
+                                 systems
+                                 (valid-targets->options targets)
+                                 build-stats
+                                 builds-with-context)))))))
diff --git a/guix-data-service/web/build/html.scm b/guix-data-service/web/build/html.scm
index 461f44a..18d045a 100644
--- a/guix-data-service/web/build/html.scm
+++ b/guix-data-service/web/build/html.scm
@@ -25,6 +25,8 @@
 (define (view-builds query-parameters
                      build-status-strings
                      build-server-options
+                     valid-systems
+                     valid-targets
                      stats
                      builds)
   (layout
@@ -82,6 +84,25 @@
             query-parameters
             #:options build-server-options
             #:help-text "Return builds from these build servers.")
+          ,(form-horizontal-control
+            "System" query-parameters
+            #:options valid-systems
+            #:allow-selecting-multiple-options #f
+            #:help-text "Only include derivations for this system."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Target" query-parameters
+            #:options valid-targets
+            #:allow-selecting-multiple-options #f
+            #:help-text "Only include derivations that are build for this system."
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "Limit results" query-parameters
+            #:help-text "The maximum number of results to return.")
+          ,(form-horizontal-control
+            "All results" query-parameters
+            #:type "checkbox"
+            #:help-text "Return all results")
           (div (@ (class "form-group form-group-lg"))
                (div (@ (class "col-sm-offset-2 col-sm-10"))
                     (button (@ (type "submit")