Improve listing agent build allocation plans

1 files changed, 28 insertions, 0 deletions

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