@@ 107,47 107,44 @@ BODY..., and restore them."
(store-lift topologically-sorted))
-(define* (copy-item item target
+(define* (copy-item item references target
#:key (log-port (current-error-port)))
- "Copy ITEM to the store under root directory TARGET and register it."
- (mlet* %store-monad ((refs (references* item)))
- (let ((dest (string-append target item))
- (state (string-append target "/var/guix")))
- (format log-port "copying '~a'...~%" item)
-
- ;; Remove DEST if it exists to make sure that (1) we do not fail badly
- ;; while trying to overwrite it (see <http://bugs.gnu.org/20722>), and
- ;; (2) we end up with the right contents.
- (when (file-exists? dest)
- (delete-file-recursively dest))
-
- (copy-recursively item dest
- #:log (%make-void-port "w"))
-
- ;; Register ITEM; as a side-effect, it resets timestamps, etc.
- ;; Explicitly use "TARGET/var/guix" as the state directory, to avoid
- ;; reproducing the user's current settings; see
- ;; <http://bugs.gnu.org/18049>.
- (unless (register-path item
- #:prefix target
- #:state-directory state
- #:references refs)
- (leave (G_ "failed to register '~a' under '~a'~%")
- item target))
-
- (return #t))))
+ "Copy ITEM to the store under root directory TARGET and register it with
+REFERENCES as its set of references."
+ (let ((dest (string-append target item))
+ (state (string-append target "/var/guix")))
+ (format log-port "copying '~a'...~%" item)
+
+ ;; Remove DEST if it exists to make sure that (1) we do not fail badly
+ ;; while trying to overwrite it (see <http://bugs.gnu.org/20722>), and
+ ;; (2) we end up with the right contents.
+ (when (file-exists? dest)
+ (delete-file-recursively dest))
+
+ (copy-recursively item dest
+ #:log (%make-void-port "w"))
+
+ ;; Register ITEM; as a side-effect, it resets timestamps, etc.
+ ;; Explicitly use "TARGET/var/guix" as the state directory, to avoid
+ ;; reproducing the user's current settings; see
+ ;; <http://bugs.gnu.org/18049>.
+ (unless (register-path item
+ #:prefix target
+ #:state-directory state
+ #:references references)
+ (leave (G_ "failed to register '~a' under '~a'~%")
+ item target))))
(define* (copy-closure item target
#:key (log-port (current-error-port)))
"Copy ITEM and all its dependencies to the store under root directory
TARGET, and register them."
- (mlet* %store-monad ((refs (references* item))
- (to-copy (topologically-sorted*
- (delete-duplicates (cons item refs)
- string=?))))
- (sequence %store-monad
- (map (cut copy-item <> target #:log-port log-port)
- to-copy))))
+ (mlet* %store-monad ((to-copy (topologically-sorted* (list item)))
+ (refs (mapm %store-monad references* to-copy)))
+ (for-each (cut copy-item <> <> target #:log-port log-port)
+ to-copy refs)
+
+ (return *unspecified*)))
(define* (install-bootloader installer-drv
#:key