From 21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 31 Jan 2021 09:38:17 +0000 Subject: Support listing and canceling builds by derivation system --- scripts/guix-build-coordinator.in | 50 ++++++++++++++++++++++++++++++++++----- 1 file changed, 44 insertions(+), 6 deletions(-) (limited to 'scripts/guix-build-coordinator.in') diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 537addc..78a9885 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -157,6 +157,20 @@ (or (assq-ref result 'not-tags) '())) (alist-delete 'not-tags result)))) + (option '("system") #t #f + (lambda (opt name arg result) + (alist-cons 'systems + (cons arg + (or (assq-ref result 'systems) + '())) + (alist-delete 'systems result)))) + (option '("not-system") #t #f + (lambda (opt name arg result) + (alist-cons 'not-systems + (cons arg + (or (assq-ref result 'not-systems) + '())) + (alist-delete 'not-systems result)))) (option '("processed") #t #f (lambda (opt name arg result) (alist-cons 'processed @@ -181,6 +195,8 @@ (define %builds-list-option-defaults `((tags . ()) (not-tags . ()) + (systems . ()) + (not-systems . ()) (processed . 'unset) (canceled . 'unset) (limit . 1000))) @@ -207,11 +223,27 @@ ((key) key)) (or (assq-ref result 'not-tags) '())) - (alist-delete 'not-tags result)))))) + (alist-delete 'not-tags result)))) + (option '("system") #t #f + (lambda (opt name arg result) + (alist-cons 'systems + (cons arg + (or (assq-ref result 'systems) + '())) + (alist-delete 'systems result)))) + (option '("not-system") #t #f + (lambda (opt name arg result) + (alist-cons 'not-systems + (cons arg + (or (assq-ref result 'not-systems) + '())) + (alist-delete 'not-systems result)))))) (define %build-cancel-option-defaults `((tags . ()) - (not-tags . ()))) + (not-tags . ()) + (systems . ()) + (not-systems . ()))) (define %agent-tag-options (list (option '("tag") #t #f @@ -427,6 +459,8 @@ canceled?: ~A (assq-ref opts 'coordinator) #:tags (assq-ref opts 'tags) #:not-tags (assq-ref opts 'not-tags) + #:systems (assq-ref opts 'systems) + #:not-systems (assq-ref opts 'not-systems) #:processed (assq-ref opts 'processed) #:canceled (assq-ref opts 'canceled) #:after-id (or after-id (assq-ref opts 'after-id)) @@ -452,10 +486,12 @@ tags: "false") (assoc-ref build-details "priority") (string-join - (map (match-lambda - ((key . val) - (string-append " " key ": " val))) - (assoc-ref build-details "tags")) + (map (lambda (tag) + (let ((key (assoc-ref tag "key")) + (val (assoc-ref tag "value"))) + (string-append " " key ": " val))) + (vector->list + (assoc-ref build-details "tags"))) "\n"))) (vector->list (assoc-ref response "builds"))) @@ -498,6 +534,8 @@ tags: (assq-ref opts 'coordinator) #:tags (assq-ref opts 'tags) #:not-tags (assq-ref opts 'not-tags) + #:systems (assq-ref opts 'systems) + #:not-systems (assq-ref opts 'not-systems) #:processed #f #:canceled #f #:after-id after-id -- cgit v1.2.3