From 7912b9bfe3d40f6f5393d764c6a18cbdb4b6880e Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 9 Oct 2022 11:53:01 +0100 Subject: Improve listing agent build allocation plans --- scripts/guix-build-coordinator.in | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'scripts/guix-build-coordinator.in') diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 2483c7e..77dd245 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -850,6 +850,34 @@ tags: ('value . value)) (simple-format #t " - ~A: ~A\n" key value))) new-tags)))))) + (("agent" agent-id "build-allocation-plan" rest ...) + (let ((opts (parse-options (append %client-options + %base-options) + (append %client-option-defaults + %base-option-defaults) + rest))) + (let ((build-allocation-plan (assoc-ref + (request-agent-build-allocation-plan + (assq-ref opts 'coordinator) + agent-id) + "build_allocation_plan"))) + (vector-for-each + (lambda (index build) + (simple-format #t "~A: ~A\n" index (assoc-ref build "uuid")) + (simple-format #t " derivation name: ~A\n" + (assoc-ref build "derivation-name")) + (let ((tags (assoc-ref build "tags"))) + (unless (eq? 0 (vector-length tags)) + (simple-format #t " tags:\n") + (vector-for-each + (lambda (_ tag) + (let ((key (assoc-ref tag "key")) + (value (assoc-ref tag "value"))) + (simple-format #t " - ~A: ~A\n" + key value))) + tags))) + (newline)) + build-allocation-plan)))) (("agent" "list" rest ...) (let ((opts (parse-options %base-options (append %base-option-defaults -- cgit v1.2.3