aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2021-01-17 21:23:34 +0000
committerChristopher Baines <mail@cbaines.net>2021-01-17 21:23:34 +0000
commitbd73f8c42963dc7c9a1c769179443849129ada1e (patch)
treec5d928f652a639ca62b903e84d55981d0e9a45cc /scripts
parentf462547786710c72ab5dc65faf84fb9cdb5ea339 (diff)
downloadbuild-coordinator-bd73f8c42963dc7c9a1c769179443849129ada1e.tar
build-coordinator-bd73f8c42963dc7c9a1c769179443849129ada1e.tar.gz
Fix up a load of the tag related code
Turns out vector-fold and vector-map don't work like I'd expected them to, like fold and map for vectors.
Diffstat (limited to 'scripts')
-rw-r--r--scripts/guix-build-coordinator.in50
1 files changed, 37 insertions, 13 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index c33d37a..537addc 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -28,6 +28,7 @@
(use-modules (srfi srfi-1)
(srfi srfi-19)
(srfi srfi-37)
+ (srfi srfi-43)
(ice-9 match)
(web uri)
(fibers)
@@ -114,7 +115,9 @@
(lambda (opt name arg result)
(alist-cons 'tags
(cons (match (string-split arg #\=)
- ((key value) (cons key value)))
+ ((key value)
+ `((key . ,key)
+ (value . ,value))))
(or (assq-ref result 'tags)
'()))
(alist-delete 'tags result))))
@@ -136,7 +139,9 @@
(lambda (opt name arg result)
(alist-cons 'tags
(cons (match (string-split arg #\=)
- ((key value) (cons key value))
+ ((key value)
+ `((key . ,key)
+ (value . ,value)))
((key) key))
(or (assq-ref result 'tags)
'()))
@@ -145,7 +150,9 @@
(lambda (opt name arg result)
(alist-cons 'not-tags
(cons (match (string-split arg #\=)
- ((key value) (cons key value))
+ ((key value)
+ `((key . ,key)
+ (value . ,value)))
((key) key))
(or (assq-ref result 'not-tags)
'()))
@@ -183,7 +190,9 @@
(lambda (opt name arg result)
(alist-cons 'tags
(cons (match (string-split arg #\=)
- ((key value) (cons key value))
+ ((key value)
+ `((key . ,key)
+ (value . ,value)))
((key) key))
(or (assq-ref result 'tags)
'()))
@@ -192,7 +201,9 @@
(lambda (opt name arg result)
(alist-cons 'not-tags
(cons (match (string-split arg #\=)
- ((key value) (cons key value))
+ ((key value)
+ `((key . ,key)
+ (value . ,value)))
((key) key))
(or (assq-ref result 'not-tags)
'()))
@@ -207,7 +218,9 @@
(lambda (opt name arg result)
(alist-cons 'tags
(cons (match (string-split arg #\=)
- ((key value) (cons key value)))
+ ((key value)
+ `((key . ,key)
+ (value . ,value))))
(or (assq-ref result 'tags)
'()))
(alist-delete 'tags result))))
@@ -215,7 +228,9 @@
(lambda (opt name arg result)
(alist-cons 'remove-tags
(cons (match (string-split arg #\=)
- ((key value) (cons key value))
+ ((key value)
+ `((key . ,key)
+ (value . ,value)))
((key) key))
(or (assq-ref result 'remove-tags)
'()))
@@ -613,12 +628,20 @@ tags:
(let ((agent-details (request-agent-details
(assq-ref opts 'coordinator)
agent-id)))
- (let* ((initial-tags (assoc-ref agent-details "tags"))
+ (let* ((initial-tags (vector-fold
+ (lambda (_ result tag)
+ (cons `((key . ,(assoc-ref tag "key"))
+ (value . ,(assoc-ref tag "value")))
+ result))
+ '()
+ (assoc-ref agent-details "tags")))
(new-tags (remove
(match-lambda
- ((key . val)
+ ((('key . key)
+ ('value . val))
(any (match-lambda
- ((k . v)
+ ((('key . k)
+ ('value . v))
(and (string=? key k)
(string=? val v)))
(k
@@ -629,11 +652,12 @@ tags:
(let ((response (send-replace-agent-tags-request
(assq-ref opts 'coordinator)
agent-id
- new-tags)))
+ (list->vector new-tags))))
(simple-format #t "changed tags to:\n")
(for-each (match-lambda
- ((k . v)
- (simple-format #t " - ~A: ~A\n" k v)))
+ ((('key . key)
+ ('value . value))
+ (simple-format #t " - ~A: ~A\n" key value)))
new-tags))))))
(("agent" "list" rest ...)
(let ((opts (parse-options %base-options