From 1f2c60c85b2b24d2dcb66133fd50bbdedcaacdbd Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 29 Aug 2023 15:09:26 +0100
Subject: Replace request-builds-list by fold-builds

As this can wait until the stream is finished and properly close the port.
---
 scripts/guix-build-coordinator.in | 127 +++++++++++++++++++-------------------
 1 file changed, 62 insertions(+), 65 deletions(-)

(limited to 'scripts')

diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index a6e87c7..655e3ce 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -536,23 +536,11 @@ canceled?:       ~A
                                       %client-option-defaults
                                       %builds-list-option-defaults)
                               rest)))
-     (let ((response (request-builds-list
-                      (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)
-                      #:priority-> (assq-ref opts 'priority->)
-                      #:priority-< (assq-ref opts 'priority-<)
-                      #:relationship (assq-ref opts 'relationship)
-                      #:after-id (assq-ref opts 'after-id)
-                      #:limit (assq-ref opts 'limit))))
-       (stream-for-each
-        (lambda (build-details)
-          (simple-format (current-output-port)
-                         "id: ~A
+     (fold-builds
+      (assq-ref opts 'coordinator)
+      (lambda (build-details _)
+        (simple-format (current-output-port)
+                       "id: ~A
 derivation: ~A
 processed: ~A
 canceled: ~A
@@ -560,24 +548,36 @@ priority: ~A
 tags:
 ~A
 \n"
-                         (assoc-ref build-details "uuid")
-                         (assoc-ref build-details "derivation-name")
-                         (if (assoc-ref build-details "processed")
-                             "true"
-                             "false")
-                         (if (assoc-ref build-details "canceled")
-                             "true"
-                             "false")
-                         (assoc-ref build-details "priority")
-                         (string-join
-                          (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")))
-        response))))
+                       (assoc-ref build-details "uuid")
+                       (assoc-ref build-details "derivation-name")
+                       (if (assoc-ref build-details "processed")
+                           "true"
+                           "false")
+                       (if (assoc-ref build-details "canceled")
+                           "true"
+                           "false")
+                       (assoc-ref build-details "priority")
+                       (string-join
+                        (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"))
+        #f)
+      #f
+      #: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)
+      #:priority-> (assq-ref opts 'priority->)
+      #:priority-< (assq-ref opts 'priority-<)
+      #:relationship (assq-ref opts 'relationship)
+      #:after-id (assq-ref opts 'after-id)
+      #:limit (assq-ref opts 'limit))))
 
   (("build" "show-blocking" rest ...)
    (let ((opts (parse-options (append %base-options
@@ -611,21 +611,19 @@ tags:
        (simple-format (current-error-port)
                       "requesting matching builds\n")
        (force-output (current-error-port))
-       (let* ((response (request-builds-list
-                         (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
-                         #:relationship (assq-ref opts 'relationship))))
-
-         (stream->list
-          (stream-map
-           (lambda (build-details)
-             (assoc-ref build-details "uuid"))
-           response))))
+       (fold-builds
+        (assq-ref opts 'coordinator)
+        (lambda (build-details result)
+          (cons (assoc-ref build-details "uuid")
+                result))
+        '()
+        #: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
+        #:relationship (assq-ref opts 'relationship)))
 
      (match (assq-ref opts 'arguments)
        (#f
@@ -687,21 +685,20 @@ tags:
                                       %build-update-priority-option-defaults)
                               rest)))
      (define (find-matching-builds)
-       (let* ((response (request-builds-list
-                         (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
-                         #:priority-> (assq-ref opts 'priority->)
-                         #:priority-< (assq-ref opts 'priority-<))))
-
-         (stream-map
-          (lambda (build-details)
-            (assoc-ref build-details "uuid"))
-          response)))
+       (fold-builds
+        (assq-ref opts 'coordinator)
+        (lambda (build-details result)
+          (cons (assoc-ref build-details "uuid")
+                result))
+        '()
+        #: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
+        #:priority-> (assq-ref opts 'priority->)
+        #:priority-< (assq-ref opts 'priority-<)))
 
      (match (assq-ref opts 'arguments)
        (#f
-- 
cgit v1.2.3