summaryrefslogtreecommitdiff
path: root/guix/grafts.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/grafts.scm')
-rw-r--r--guix/grafts.scm32
1 files changed, 23 insertions, 9 deletions
diff --git a/guix/grafts.scm b/guix/grafts.scm
index 53e697688a..80ae27e9b0 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -227,17 +227,33 @@ resulting list of grafts.
This is a monadic procedure in %STATE-MONAD where the state is a vhash mapping
derivations to the corresponding set of grafts."
+ (define (graft-origin? drv graft)
+ ;; Return true if DRV corresponds to the origin of GRAFT.
+ (match graft
+ (($ <graft> (? derivation? origin) output)
+ (match (assoc-ref (derivation->output-paths drv) output)
+ ((? string? result)
+ (string=? result
+ (derivation->output-path origin output)))
+ (_
+ #f)))
+ (_
+ #f)))
+
(define (dependency-grafts item)
(let-values (((drv output) (item->deriver store item)))
(if drv
- (cumulative-grafts store drv grafts references
- #:outputs (list output)
- #:guile guile
- #:system system)
+ ;; If GRAFTS already contains a graft from DRV, do not override it.
+ (if (find (cut graft-origin? drv <>) grafts)
+ (state-return grafts)
+ (cumulative-grafts store drv grafts references
+ #:outputs (list output)
+ #:guile guile
+ #:system system))
(state-return grafts))))
(define (return/cache cache value)
- (mbegin %store-monad
+ (mbegin %state-monad
(set-current-state (vhash-consq drv value cache))
(return value)))
@@ -250,10 +266,8 @@ derivations to the corresponding set of grafts."
(() ;no dependencies
(return/cache cache grafts))
(deps ;one or more dependencies
- (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps))
- (cache (current-state)))
- (let* ((grafts (delete-duplicates (concatenate grafts) equal?))
- (origins (map graft-origin-file-name grafts)))
+ (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps)))
+ (let ((grafts (delete-duplicates (concatenate grafts) equal?)))
(match (filter (lambda (graft)
(member (graft-origin-file-name graft) deps))
grafts)