diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 005632f..1deb389 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -123,52 +123,54 @@ if required." (define (build-packages store db jobs) "Build JOBS and return a list of Build results." - (map (λ (job) - (let* ((name (assq-ref job #:job-name)) - (drv (assq-ref job #:derivation)) - (eval-id (assq-ref job #:eval-id)) - (success? #t) - (error-log (string-append (%package-cachedir) "/" - name ".log"))) - (simple-format #t "building ~A...\n" drv) - (let ((log (call-with-output-string - (λ (port) - (parameterize ((current-build-output-port port)) - (catch 'srfi-34 - (λ () - (build-derivations store (list drv))) - (λ (key . args) - (set! success? #f) - (pk "kets key:" key "args:" args)))))))) - (when (not success?) - (with-output-to-file error-log - (lambda () (display log))) - (simple-format #t "build failed: ~a\n" error-log)) - (let* ((output (and success? (derivation-path->output-path drv))) - (log (if success? (log-file store output) error-log)) - (build `((#:derivation . ,drv) - (#:eval-id . ,eval-id) - (#:log . ,log) - (#:output . ,output)))) - (db-add-build db build) - (simple-format #t "~A\n" output) - build)))) - jobs)) + (define (build job) + (let* ((name (assq-ref job #:job-name)) + (drv (assq-ref job #:derivation)) + (eval-id (assq-ref job #:eval-id)) + (success? #t) + (error-log (string-append (%package-cachedir) "/" + name ".log"))) + (simple-format #t "building ~A...\n" drv) + (let ((log (call-with-output-string + (λ (port) + (parameterize ((current-build-output-port port)) + (catch 'srfi-34 + (λ () + (build-derivations store (list drv))) + (λ (key . args) + (set! success? #f) + (pk "kets key:" key "args:" args)))))))) + (when (not success?) + (with-output-to-file error-log + (λ () (display log))) + (simple-format #t "build failed: ~a\n" error-log)) + (let* ((output (and success? (derivation-path->output-path drv))) + (log (if success? (log-file store output) error-log)) + (build `((#:derivation . ,drv) + (#:eval-id . ,eval-id) + (#:log . ,log) + (#:output . ,output)))) + (db-add-build db build) + (simple-format #t "~A\n" output) + build)))) + + (map build jobs)) (define (process-specs db jobspecs) "Evaluate and build JOBSPECS and store results in DB." - (for-each (λ (spec) - (let ((commit (fetch-repository spec)) - (stamp (db-get-stamp db spec))) - (unless (string=? commit stamp) - (unless (assq-ref spec #:no-compile?) - (compile (string-append (%package-cachedir) "/" - (assq-ref spec #:name)))) - (with-store store - (let* ((spec* (acons #:current-commit commit spec)) - (jobs (evaluate store db spec*))) - (unless (%use-substitutes?) - (set-build-options store #:use-substitutes? #f)) - (build-packages store db jobs)))) - (db-add-stamp db spec commit))) - jobspecs)) + (define (process spec) + (let ((commit (fetch-repository spec)) + (stamp (db-get-stamp db spec))) + (unless (string=? commit stamp) + (unless (assq-ref spec #:no-compile?) + (compile (string-append (%package-cachedir) "/" + (assq-ref spec #:name)))) + (with-store store + (let* ((spec* (acons #:current-commit commit spec)) + (jobs (evaluate store db spec*))) + (unless (%use-substitutes?) + (set-build-options store #:use-substitutes? #f)) + (build-packages store db jobs)))) + (db-add-stamp db spec commit))) + + (for-each process jobspecs))