diff options
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
-rw-r--r-- | guix-build-coordinator/build-allocator.scm | 97 |
1 files changed, 44 insertions, 53 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index 588f213..8c08144 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -492,18 +492,6 @@ (let ((prioritised-builds (datastore-fetch-prioritised-unprocessed-builds datastore))) - (define systems-for-builds - ;; TODO Should be one query - (let ((table (make-hash-table))) - (for-each (lambda (build-id) - (hash-set! table - build-id - (datastore-find-build-derivation-system - datastore - build-id))) - prioritised-builds) - table)) - (define tags-for-build (let ((build-tags (make-hash-table))) (lambda (build-id) @@ -545,40 +533,41 @@ (else (error "Unknown setup failure " failure-reason))))) - (lambda (build-id) - (log "build:" build-id) - (and - (or (null? requested-systems) - (let ((build-system (hash-ref systems-for-builds build-id))) - (member build-system requested-systems))) - (agent-tags-match-build-tags agent-tags tags-for-build - agent-id build-id) - (let* ((setup-failures-for-build - (or (hash-ref setup-failures-hash build-id) - '())) - (relevant-setup-failures - (filter relevant-setup-failure? - setup-failures-for-build))) - (log "relevant setup failures:" relevant-setup-failures) - (if (null? relevant-setup-failures) - #t - #f))))) - - (when metrics-registry - (let ((counts - (hash-fold - (lambda (_ system result) - `(,@(alist-delete system result) - (,system . ,(+ 1 (or (assoc-ref result system) 0))))) - '() - systems-for-builds))) - (for-each - (match-lambda - ((system . count) - (metric-set allocator-considered-builds-metric - count - #:label-values `((system . ,system))))) - counts))) + (match-lambda + (#(build-id build-system) + (log "build:" build-id) + (and + (or (null? requested-systems) + (member build-system requested-systems)) + (agent-tags-match-build-tags agent-tags tags-for-build + agent-id build-id) + (let* ((setup-failures-for-build + (or (hash-ref setup-failures-hash build-id) + '())) + (relevant-setup-failures + (filter relevant-setup-failure? + setup-failures-for-build))) + (log "relevant setup failures:" relevant-setup-failures) + (if (null? relevant-setup-failures) + #t + #f)))))) + + ;; TODO Restore this in a more performant way + ;; (when metrics-registry + ;; (let ((counts + ;; (hash-fold + ;; (lambda (_ system result) + ;; `(,@(alist-delete system result) + ;; (,system . ,(+ 1 (or (assoc-ref result system) 0))))) + ;; '() + ;; systems-for-builds))) + ;; (for-each + ;; (match-lambda + ;; ((system . count) + ;; (metric-set allocator-considered-builds-metric + ;; count + ;; #:label-values `((system . ,system))))) + ;; counts))) (let ((result (map @@ -589,21 +578,23 @@ (build-ids (let loop ((count 0) (build-ids '()) - (potential-build-ids prioritised-builds)) + (potential-builds prioritised-builds)) (if (or (and planned-builds-for-agent-limit (>= count planned-builds-for-agent-limit)) - (null? potential-build-ids)) + (null? potential-builds)) (reverse build-ids) ;; highest priority last, so ;; reverse - (let ((potential-build (first potential-build-ids))) - (if (filter-proc potential-build) + (let ((potential-build-details (first potential-builds))) + (if (filter-proc potential-build-details) (loop (+ 1 count) - (cons potential-build + (cons (vector-ref + potential-build-details + 0) build-ids) - (cdr potential-build-ids)) + (cdr potential-builds)) (loop count build-ids - (cdr potential-build-ids)))))))) + (cdr potential-builds)))))))) (cons agent-id build-ids))) (map (lambda (agent) (assq-ref agent 'uuid)) |