diff options
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/guix-build-coordinator.in | 144 |
1 files changed, 56 insertions, 88 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index daa0873..787542c 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -38,6 +38,7 @@ (srfi srfi-37) (srfi srfi-43) (ice-9 match) + (ice-9 streams) (ice-9 suspendable-ports) (web uri) (fibers) @@ -242,8 +243,7 @@ %common-build-filtering-options)) (define %builds-list-option-defaults - `(,@%common-build-filtering-option-defaults - (limit . 1000))) + `(,@%common-build-filtering-option-defaults)) (define %build-cancel-options (list (option '("tag") #t #f @@ -529,24 +529,23 @@ canceled?: ~A %client-option-defaults %builds-list-option-defaults) rest))) - (let loop ((after-id #f)) - (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 (or after-id (assq-ref opts 'after-id)) - #:limit (assq-ref opts 'limit)))) - (for-each - (lambda (build-details) - (simple-format (current-output-port) - "id: ~A + (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 derivation: ~A processed: ~A canceled: ~A @@ -554,31 +553,25 @@ 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"))) - (vector->list (assoc-ref response "builds"))) + (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)))) - (unless (= (vector-length (assoc-ref response "builds")) 0) - (loop - (assoc-ref (vector-ref - (assoc-ref response "builds") - (- (vector-length (assoc-ref response "builds")) 1)) - "uuid"))))))) (("build" "show-blocking" rest ...) (let ((opts (parse-options (append %base-options %client-options @@ -608,8 +601,6 @@ tags: %build-cancel-option-defaults) rest))) (define (get-batch) - (define limit 1000) - (simple-format (current-error-port) "requesting matching builds\n") (force-output (current-error-port)) @@ -621,17 +612,12 @@ tags: #:not-systems (assq-ref opts 'not-systems) #:processed #f #:canceled #f - #:relationship 'no-dependent-builds - #:limit 1000)) - (received-builds - (vector-length (assoc-ref response "builds")))) + #:relationship 'no-dependent-builds))) - (fold - (lambda (build-details result) - (cons (assoc-ref build-details "uuid") - result)) - '() - (vector->list (assoc-ref response "builds"))))) + (stream-map + (lambda (build-details) + (assoc-ref build-details "uuid")) + response))) (match (assq-ref opts 'arguments) (#f @@ -689,39 +675,21 @@ tags: %build-update-priority-option-defaults) rest))) (define (find-matching-builds) - (define limit 1000) + (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-<)))) - (let loop ((after-id #f) - (result '())) - (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-<) - #:after-id after-id - #:limit 1000)) - (received-builds - (vector-length (assoc-ref response "builds"))) - (new-result - (fold - (lambda (build-details result) - (cons (assoc-ref build-details "uuid") - result)) - result - (vector->list (assoc-ref response "builds"))))) - (display "." (current-error-port)) - (force-output (current-error-port)) - (if (< received-builds limit) - new-result - (loop (assoc-ref (vector-ref (assoc-ref response "builds") - (- received-builds 1)) - "uuid") - new-result))))) + (stream-map + (lambda (build-details) + (assoc-ref build-details "uuid")) + response))) (match (assq-ref opts 'arguments) (#f |