diff options
| author | Christopher Baines <mail@cbaines.net> | 2021-01-17 21:23:34 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-01-17 21:23:34 +0000 |
| commit | bd73f8c42963dc7c9a1c769179443849129ada1e (patch) | |
| tree | c5d928f652a639ca62b903e84d55981d0e9a45cc /scripts/guix-build-coordinator.in | |
| parent | f462547786710c72ab5dc65faf84fb9cdb5ea339 (diff) | |
| download | build-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/guix-build-coordinator.in')
| -rw-r--r-- | scripts/guix-build-coordinator.in | 50 |
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 |