diff options
-rw-r--r-- | scripts/guix-build-coordinator.in | 86 |
1 files changed, 57 insertions, 29 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 1774fa3..ba500e1 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -171,41 +171,69 @@ rest))) (let ((datastore (database-uri->datastore (assq-ref opts 'database)))) - (match (assq-ref opts 'arguments) - ((build-id) - - (let ((build-details (datastore-find-build datastore build-id))) - (simple-format #t "derivation name: ~A + (define (display-build build-details) + (simple-format #t "derivation name: ~A priority: ~A processed?: ~A " - (assq-ref build-details 'derivation-name) - (assq-ref build-details 'priority) - (assq-ref build-details 'processed)) + (assq-ref build-details 'derivation-name) + (assq-ref build-details 'priority) + (assq-ref build-details 'processed)) - (let ((setup-failures - (datastore-list-setup-failures-for-build datastore build-id))) - (unless (null? setup-failures) - (display "\nsetup failures:\n") - (for-each - (lambda (setup-failure) - (simple-format #t " - agent: ~A + (let ((setup-failures + (datastore-list-setup-failures-for-build + datastore + (assq-ref build-details 'uuid)))) + (unless (null? setup-failures) + (display "\nsetup failures:\n") + (for-each + (lambda (setup-failure) + (simple-format #t " - agent: ~A failure reason: ~A " - (assq-ref setup-failure 'agent-id) - (assq-ref setup-failure 'failure-reason)) - (when (string=? (assq-ref setup-failure 'failure-reason) - "missing_inputs") - (simple-format #t " missing inputs:\n") - (for-each (lambda (missing-input) - (simple-format #t - " - ~A\n" - missing-input)) - (datastore-list-setup-failure-missing-inputs - datastore - (assq-ref setup-failure 'id))) - (newline))) - setup-failures))))))))) + (assq-ref setup-failure 'agent-id) + (assq-ref setup-failure 'failure-reason)) + (when (string=? (assq-ref setup-failure 'failure-reason) + "missing_inputs") + (simple-format #t " missing inputs:\n") + (for-each (lambda (missing-input) + (simple-format #t + " - ~A\n" + missing-input) + (let ((builds-for-missing-input + (datastore-list-builds-for-output + datastore + missing-input))) + (for-each + (lambda (missing-input-build) + (simple-format + #t + " - ~A~A\n" + (assq-ref missing-input-build 'uuid) + (if (= 0 (assq-ref missing-input-build + 'processed)) + " (finished)" + ""))) + builds-for-missing-input))) + (datastore-list-setup-failure-missing-inputs + datastore + (assq-ref setup-failure 'id))) + (newline))) + setup-failures)))) + + (define (output? s) + (string-prefix? "/gnu/store/" s)) + + (match (assq-ref opts 'arguments) + (((? output? output)) + (for-each display-build + (datastore-list-builds-for-output datastore output))) + ((build-id) + (match (datastore-find-build datastore build-id) + (#f (display "no build found\n")) + (build-details + (display-build `((uuid . ,build-id) + ,@build-details))))))))) (("build" rest ...) (let ((opts (parse-options (append %build-options %base-options) |