diff options
| author | Marius Bakke <mbakke@fastmail.com> | 2020-03-30 12:17:33 +0200 |
|---|---|---|
| committer | Marius Bakke <mbakke@fastmail.com> | 2020-03-30 12:17:33 +0200 |
| commit | ae0badf5bb791428423a98d4e4e2b8d297a5d4be (patch) | |
| tree | 4282d243db3e90839a5f7d3b5878674ccd0e2e14 /guix/profiles.scm | |
| parent | ee401ed9249fbe284ef1b9b437d39207ca88131b (diff) | |
| parent | 927f3655662b41f25225ea03baa3ded687aa7cbb (diff) | |
| download | guix-patches-ae0badf5bb791428423a98d4e4e2b8d297a5d4be.tar guix-patches-ae0badf5bb791428423a98d4e4e2b8d297a5d4be.tar.gz | |
Merge branch 'master' into core-updates
Conflicts:
gnu/packages/admin.scm
gnu/packages/commencement.scm
gnu/packages/guile.scm
gnu/packages/linux.scm
gnu/packages/package-management.scm
gnu/packages/pulseaudio.scm
gnu/packages/web.scm
Diffstat (limited to 'guix/profiles.scm')
| -rw-r--r-- | guix/profiles.scm | 57 |
1 files changed, 32 insertions, 25 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 2a838d3a9a..9150886081 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -280,29 +280,37 @@ file name." (define lookup (manifest-entry-lookup manifest)) - (with-monad %store-monad + (define candidates + (filter-map (lambda (entry) + (let ((other (lookup (manifest-entry-name entry) + (manifest-entry-output entry)))) + (and other (list entry other)))) + (manifest-transitive-entries manifest))) + + (define lower-pair + (match-lambda + ((first second) + (mlet %store-monad ((first (lower-manifest-entry first system + #:target target)) + (second (lower-manifest-entry second system + #:target target))) + (return (list first second)))))) + + ;; Start by lowering CANDIDATES "in parallel". + (mlet %store-monad ((lst (mapm/accumulate-builds lower-pair candidates))) (foldm %store-monad - (lambda (entry result) - (match (lookup (manifest-entry-name entry) - (manifest-entry-output entry)) - ((? manifest-entry? second) ;potential conflict - (mlet %store-monad ((first (lower-manifest-entry entry system - #:target - target)) - (second (lower-manifest-entry second system - #:target - target))) - (if (string=? (manifest-entry-item first) - (manifest-entry-item second)) - (return result) - (raise (condition - (&profile-collision-error - (entry first) - (conflict second))))))) - (#f ;no conflict - (return result)))) + (lambda (entries result) + (match entries + ((first second) + (if (string=? (manifest-entry-item first) + (manifest-entry-item second)) + (return result) + (raise (condition + (&profile-collision-error + (entry first) + (conflict second)))))))) #t - (manifest-transitive-entries manifest)))) + lst))) (define* (package->manifest-entry package #:optional (output "out") #:key (parent (delay #f)) @@ -1523,10 +1531,9 @@ are cross-built for TARGET." #:target target))) (extras (if (null? (manifest-entries manifest)) (return '()) - (mapm %store-monad - (lambda (hook) - (hook manifest)) - hooks)))) + (mapm/accumulate-builds (lambda (hook) + (hook manifest)) + hooks)))) (define inputs (append (filter-map (lambda (drv) (and (derivation? drv) |