diff options
| author | Christopher Baines <mail@cbaines.net> | 2021-01-31 09:38:17 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-01-31 09:38:17 +0000 |
| commit | 21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33 (patch) | |
| tree | 7a19a7ede330fb47a38c85a1ffcf6ee02a08f6c3 /scripts/guix-build-coordinator.in | |
| parent | 302142db4f6a330befd85f9daee904cf8bfc885d (diff) | |
| download | build-coordinator-21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33.tar build-coordinator-21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33.tar.gz | |
Support listing and canceling builds by derivation system
Diffstat (limited to 'scripts/guix-build-coordinator.in')
| -rw-r--r-- | scripts/guix-build-coordinator.in | 50 |
1 files changed, 44 insertions, 6 deletions
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 |