diff options
author | Christopher Baines <mail@cbaines.net> | 2023-08-29 15:09:26 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-08-29 15:09:26 +0100 |
commit | 1f2c60c85b2b24d2dcb66133fd50bbdedcaacdbd (patch) | |
tree | 6b57b6d2ae0c26db7820f16c5204283d8975d01f /scripts | |
parent | cbded42c284cca4ecaaebbf0a666cf89efc465a7 (diff) | |
download | build-coordinator-1f2c60c85b2b24d2dcb66133fd50bbdedcaacdbd.tar build-coordinator-1f2c60c85b2b24d2dcb66133fd50bbdedcaacdbd.tar.gz |
Replace request-builds-list by fold-builds
As this can wait until the stream is finished and properly close the port.
Diffstat (limited to 'scripts')
-rw-r--r-- | scripts/guix-build-coordinator.in | 127 |
1 files changed, 62 insertions, 65 deletions
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 |