diff options
| author | Christopher Baines <mail@cbaines.net> | 2021-01-17 20:27:58 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-01-17 20:27:58 +0000 |
| commit | 2123064a21236e9a91716effef4fc522172a95fd (patch) | |
| tree | 5e8b5c2e204844de4d260b8102a37d9266c9380e /guix-build-coordinator/build-allocator.scm | |
| parent | 7572f18c00d628d7ac45d7ab0096af03780ae540 (diff) | |
| download | build-coordinator-2123064a21236e9a91716effef4fc522172a95fd.tar build-coordinator-2123064a21236e9a91716effef4fc522172a95fd.tar.gz | |
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.
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 33 |
1 files changed, 25 insertions, 8 deletions
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) |