ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-27 14:52:05 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

profiles: Use 'mapm/accumulate-builds'.

Browse source 
* guix/profiles.scm (check-for-collisions): Use 'mapm/accumulate-builds'
to lower manifest entries.  Call 'foldm' over the already-lowered entries.
(profile-derivation): Use 'mapm/accumulate-builds' instead of 'mapm'
when calling HOOKS.
This commit is contained in:
Ludovic Courtès 2020-03-25 12:45:12 +01:00
parent 584dfdac37
commit 25af35fa32
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
guix/profiles.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
@ -280,29 +280,37 @@ (define* (check-for-collisions manifest system #:key target)
(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))
@ -1521,10 +1529,9 @@ (define* (profile-derivation manifest
#: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)