aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2021-01-31 09:38:17 +0000
committerChristopher Baines <mail@cbaines.net>2021-01-31 09:38:17 +0000
commit21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33 (patch)
tree7a19a7ede330fb47a38c85a1ffcf6ee02a08f6c3 /scripts
parent302142db4f6a330befd85f9daee904cf8bfc885d (diff)
downloadbuild-coordinator-21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33.tar
build-coordinator-21ff9aa32bc895ee84f0d68e5d2c12bcfd77ad33.tar.gz
Support listing and canceling builds by derivation system
Diffstat (limited to 'scripts')
-rw-r--r--scripts/guix-build-coordinator.in50
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