From 633e757fe8668d88c0cf7bd43cf7a528003374a0 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 14 Dec 2019 20:17:53 +0000
Subject: Break down the build stats by build server

---
 guix-data-service/model/build.scm          | 32 +++++++++++++++++++++++-------
 guix-data-service/web/build/controller.scm |  5 ++++-
 guix-data-service/web/build/html.scm       | 14 ++++++++++---
 3 files changed, 40 insertions(+), 11 deletions(-)

diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm
index a5c535a..65a58da 100644
--- a/guix-data-service/model/build.scm
+++ b/guix-data-service/model/build.scm
@@ -11,10 +11,11 @@
             insert-build
             ensure-build-exists))
 
-(define (select-build-stats conn)
+(define (select-build-stats conn build-servers)
   (define query
-    "
-SELECT latest_build_status.status AS build_status, COUNT(*)
+    (string-append
+     "
+SELECT latest_build_status.status AS build_status, builds.build_server_id, COUNT(*)
 FROM derivation_output_details_sets
 LEFT JOIN builds
    ON builds.derivation_output_details_set_id =
@@ -26,10 +27,27 @@ LEFT JOIN
   ORDER BY build_id, timestamp DESC
 ) AS latest_build_status
 ON builds.id = latest_build_status.build_id
-GROUP BY latest_build_status.status
-ORDER BY status")
-
-  (exec-query conn query))
+"
+     (if build-servers
+         (string-append
+          "WHERE builds.build_server_id IN ("
+          (string-join (map number->string build-servers)
+                       ", ")
+          ")")
+         "")
+     "
+GROUP BY latest_build_status.status, builds.build_server_id
+ORDER BY status"))
+
+  (map (match-lambda
+         (((build-status) . data)
+          (list build-status
+                (map (match-lambda
+                       ((build-server-id count)
+                        (cons (string->number build-server-id)
+                              (string->number count))))
+                     data))))
+       (group-list-by-first-n-fields 1 (exec-query conn query))))
 
 (define (select-builds-with-context conn build-statuses build-server-ids)
   (define where-conditions
diff --git a/guix-data-service/web/build/controller.scm b/guix-data-service/web/build/controller.scm
index afa8de9..e7d1399 100644
--- a/guix-data-service/web/build/controller.scm
+++ b/guix-data-service/web/build/controller.scm
@@ -80,7 +80,10 @@
                                     ((id url lookup-all-derivations)
                                      (cons url id)))
                                   (select-build-servers conn))
-                             (select-build-stats conn)
+                             (select-build-stats
+                              conn
+                              (assq-ref parsed-query-parameters
+                                        'build_server))
                              (select-builds-with-context
                               conn
                               (assq-ref parsed-query-parameters
diff --git a/guix-data-service/web/build/html.scm b/guix-data-service/web/build/html.scm
index a0956b0..f5ac6dc 100644
--- a/guix-data-service/web/build/html.scm
+++ b/guix-data-service/web/build/html.scm
@@ -42,14 +42,22 @@
          (thead
           (tr
            (th (@ (class "col-md-2")) "Status")
-           (th (@ (class "col-md-2")) "Count")))
+           ,@(map (match-lambda
+                    ((url . id)
+                     `(th (@ (class "col-md-2"))
+                          ,url)))
+                  build-server-options)))
          (tbody
           ,@(map
              (match-lambda
-               ((status count)
+               ((status counts-by-build-server-id)
                 `(tr
                   (td ,(build-status-span status))
-                  (td ,count))))
+                  ,@(map (lambda (id)
+                           `(td ,(or (assq-ref counts-by-build-server-id
+                                               id)
+                                     0)))
+                         (map cdr build-server-options)))))
              stats)))))
       (div
        (@ (class "row"))
-- 
cgit v1.2.3