diff options
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 97 |
1 files changed, 38 insertions, 59 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index 6d97240..16b00cd 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -303,13 +303,8 @@ (let* ((agents (datastore-list-agents datastore)) (setup-failures-hash (datastore-fetch-setup-failures datastore)) - (priority-ordered-unprocessed-builds - (datastore-list-unprocessed-builds datastore)) - (input-builds-for-unprocessed-builds - (datastore-fetch-input-builds-for-unprocessed-builds datastore)) - (derived-build-priorities-hash - (datastore-fetch-unprocessed-builds-with-propagated-priorities - datastore))) + (unprocessed-builds-with-built-inputs + (datastore-list-unprocessed-builds-with-built-inputs datastore))) (define (filter-builds-for-agent agent-id) (define (relevant-setup-failure? setup-failure) @@ -341,14 +336,6 @@ #t #f)))) - (define (build-sorting-function-for-agent agent-id) - (lambda (a b) - (let ((a-priority (hash-ref derived-build-priorities-hash - (assq-ref a 'uuid))) - (b-priority (hash-ref derived-build-priorities-hash - (assq-ref b 'uuid)))) - (< b-priority a-priority)))) - (define (limit-planned-builds builds) (if planned-builds-for-agent-limit (if (> (length builds) planned-builds-for-agent-limit) @@ -356,48 +343,40 @@ builds) builds)) - (define processable-builds - (filter (lambda (build) - (let ((input-builds-by-output - (hash-ref input-builds-for-unprocessed-builds - (assq-ref build 'uuid)))) - (and - input-builds-by-output - (every (match-lambda - ((output . builds) - (if (any (lambda (output-build) - (string=? - (or (assq-ref output-build 'result) - "unknown") - "success")) - builds) - #t - #f))) - input-builds-by-output)))) - priority-ordered-unprocessed-builds)) + (let ((derived-build-priorities-hash + (datastore-fetch-unprocessed-builds-with-propagated-priorities + datastore))) - (let ((result - (append-map - (lambda (agent-id) - (log "considering builds for" agent-id) - (let ((builds-sorted-by-derived-priority - (sort (filter (filter-builds-for-agent agent-id) - processable-builds) - (build-sorting-function-for-agent agent-id)))) - (if (null? builds-sorted-by-derived-priority) - '() - (let ((builds-for-agent - (limit-planned-builds builds-sorted-by-derived-priority))) - (map (lambda (build-id ordering) - (list build-id - agent-id - ordering)) - (map (lambda (build) - (assq-ref build 'uuid)) - builds-for-agent) - (iota (length builds-for-agent))))))) - (map (lambda (agent) - (assq-ref agent 'uuid)) - agents)))) - (log "finished") - result))) + (define (build-sorting-function-for-agent agent-id) + (lambda (a b) + (let ((a-priority (hash-ref derived-build-priorities-hash + (assq-ref a 'uuid))) + (b-priority (hash-ref derived-build-priorities-hash + (assq-ref b 'uuid)))) + (< b-priority a-priority)))) + + (let ((result + (append-map + (lambda (agent-id) + (log "considering builds for" agent-id) + (let ((builds-sorted-by-derived-priority + (sort (filter (filter-builds-for-agent agent-id) + unprocessed-builds-with-built-inputs) + (build-sorting-function-for-agent agent-id)))) + (if (null? builds-sorted-by-derived-priority) + '() + (let ((builds-for-agent + (limit-planned-builds builds-sorted-by-derived-priority))) + (map (lambda (build-id ordering) + (list build-id + agent-id + ordering)) + (map (lambda (build) + (assq-ref build 'uuid)) + builds-for-agent) + (iota (length builds-for-agent))))))) + (map (lambda (agent) + (assq-ref agent 'uuid)) + agents)))) + (log "finished") + result)))) |