Allow filtering the revision builds page by system

3 files changed, 74 insertions, 26 deletions

diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm
index 5c943a6..7f1d2fa 100644
--- a/guix-data-service/model/build.scm
+++ b/guix-data-service/model/build.scm
@@ -13,7 +13,9 @@
             insert-build
             ensure-build-exists))
 
-(define* (select-build-stats conn build-servers #:key revision-commit)
+(define* (select-build-stats conn build-servers
+                             #:key revision-commit
+                             system target)
   (define criteria
     `(,@(if revision-commit
             ;; Ignore cross built derivations, as I'm not aware of a build server
@@ -30,6 +32,12 @@
             '())
       ,@(if revision-commit
             '("guix_revisions.commit = $1")
+            '())
+      ,@(if system
+            '("package_derivations.system = $2")
+            '())
+      ,@(if target
+            '("package_derivations.target = $3")
             '())))
 
   (define query
@@ -85,10 +93,17 @@ ORDER BY status"))
                     query
                     `(,@(if revision-commit
                             (list revision-commit)
+                            '())
+                      ,@(if system
+                            (list system)
+                            '())
+                      ,@(if target
+                            (list target)
                             '()))))))
 
 (define* (select-builds-with-context conn build-statuses build-server-ids
-                                     #:key revision-commit)
+                                     #:key revision-commit
+                                     system target)
   (define where-conditions
     (filter
      string?
@@ -106,7 +121,11 @@ ORDER BY status"))
                       ", ")
          ")"))
       (when revision-commit
-        "guix_revisions.commit = $1"))))
+        "guix_revisions.commit = $1")
+      (when system
+        "package_derivations.system = $2")
+      (when target
+        "package_derivations.target = $3"))))
 
   (define query
     (string-append
@@ -146,9 +165,15 @@ LIMIT 100"))
 
   (exec-query conn
               query
-              (if revision-commit
-                  (list revision-commit)
-                  '())))
+              `(,@(if revision-commit
+                      (list revision-commit)
+                      '())
+                ,@(if system
+                      (list system)
+                      '())
+                ,@(if target
+                      (list target)
+                      '()))))
 
 (define (select-builds-with-context-by-derivation-file-name
          conn derivation-file-name)
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index 05a259b..90416df 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -234,7 +234,9 @@
                 (parse-query-parameters
                  request
                  `((build_status ,parse-build-status #:multi-value)
-                   (build_server ,(parse-build-server conn) #:multi-value)))))
+                   (build_server ,(parse-build-server conn) #:multi-value)
+                   (system ,parse-system #:default "x86_64-linux")
+                   (target ,parse-system #:default "x86_64-linux")))))
 
            (render-revision-builds mime-types
                                    conn
@@ -754,28 +756,36 @@
       (render-html
        #:sxml (view-revision-builds query-parameters
                                     build-status-strings
+                                    (valid-systems conn)
                                     '()
                                     '()
                                     '()))
-      (render-html
-       #:sxml (view-revision-builds query-parameters
-                                    build-status-strings
-                                    (map (match-lambda
-                                           ((id url lookup-all-derivations)
-                                            (cons url id)))
-                                         (select-build-servers conn))
-                                    (select-build-stats
-                                     conn
-                                     (assq-ref query-parameters
-                                               'build_server)
-                                     #:revision-commit commit-hash)
-                                    (select-builds-with-context
-                                     conn
-                                     (assq-ref query-parameters
-                                               'build_status)
-                                     (assq-ref query-parameters
-                                               'build_server)
-                                     #:revision-commit commit-hash)))))
+      (let ((system (assq-ref query-parameters 'system))
+            (target (assq-ref query-parameters 'target)))
+        (render-html
+         #:sxml (view-revision-builds query-parameters
+                                      build-status-strings
+                                      (valid-systems conn)
+                                      (map (match-lambda
+                                             ((id url lookup-all-derivations)
+                                              (cons url id)))
+                                           (select-build-servers conn))
+                                      (select-build-stats
+                                       conn
+                                       (assq-ref query-parameters
+                                                 'build_server)
+                                       #:revision-commit commit-hash
+                                       #:system system
+                                       #:target target)
+                                      (select-builds-with-context
+                                       conn
+                                       (assq-ref query-parameters
+                                                 'build_status)
+                                       (assq-ref query-parameters
+                                                 'build_server)
+                                       #:revision-commit commit-hash
+                                       #:system system
+                                       #:target target))))))
 
 (define* (render-revision-lint-warnings mime-types
                                         conn
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index 1f451d1..127005f 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -1149,6 +1149,7 @@ figure {
 
 (define (view-revision-builds query-parameters
                               build-status-strings
+                              valid-systems
                               build-server-options
                               stats
                               builds)
@@ -1210,6 +1211,18 @@ figure {
             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-systems
+            #:allow-selecting-multiple-options #f
+            #: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")