From 2123064a21236e9a91716effef4fc522172a95fd Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 17 Jan 2021 20:27:58 +0000
Subject: Stop treating collections of tags as alists

This translates poorly to JSON, as you can't have multiple values for one name
in a JSON object. Is also is risky in terms of assoc-ref being used, and not
considering more than one key. Using a vector of pairs should help in both
situations.
---
 guix-build-coordinator/build-allocator.scm | 33 ++++++++++++++++++++++--------
 1 file changed, 25 insertions(+), 8 deletions(-)

(limited to 'guix-build-coordinator/build-allocator.scm')

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 2bd69a6..81b857c 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -21,6 +21,7 @@
 (define-module (guix-build-coordinator build-allocator)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-43)
   #:use-module (ice-9 match)
   #:use-module (prometheus)
   #:use-module (guix memoization)
@@ -152,10 +153,18 @@
               (let ((build-tags (tags-for-build build-id)))
                 (every (match-lambda
                          ((agent-key . agent-value)
-                          (match (assoc-ref build-tags agent-key)
-                            ((_ . build-value)
-                             (string=? agent-value build-value))
-                            (#f #t))))
+                          (any
+                           (match-lambda
+                             ((_ . build-value)
+                              (string=? agent-value build-value)))
+                           (vector-fold
+                            (lambda (tag result)
+                              (if (string=? (car tag)
+                                            agent-key)
+                                  (cons tag result)
+                                  result))
+                            '()
+                            build-tags))))
                        agent-tags)))))
 
       (lambda (build)
@@ -527,10 +536,18 @@
                 (let ((build-tags (tags-for-build build-id)))
                   (every (match-lambda
                            ((agent-key . agent-value)
-                            (match (assoc-ref build-tags agent-key)
-                              ((_ . build-value)
-                               (string=? agent-value build-value))
-                              (#f #t))))
+                            (any
+                             (match-lambda
+                               ((_ . build-value)
+                                (string=? agent-value build-value)))
+                             (vector-fold
+                              (lambda (tag result)
+                                (if (string=? (car tag)
+                                              agent-key)
+                                    (cons tag result)
+                                    result))
+                              '()
+                              build-tags))))
                          agent-tags)))))
 
         (lambda (build-id)
-- 
cgit v1.2.3