[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#29509] [PATCH 5/6] guix system: Simplify closure copy.
From: |
Ludovic Courtès |
Subject: |
[bug#29509] [PATCH 5/6] guix system: Simplify closure copy. |
Date: |
Thu, 30 Nov 2017 14:57:01 +0100 |
* guix/scripts/system.scm (copy-item): Add 'references' argument and
remove 'references*' call. Turn into a non-monadic procedure.
(copy-closure): Remove initial call to 'references*'. Only pass ITEM to
'topologically-sorted*' since that's equivalent. Compute the list of
references corresponding to TO-COPY and pass it to 'copy-item'.
---
guix/scripts/system.scm | 61 +++++++++++++++++++++++--------------------------
1 file changed, 29 insertions(+), 32 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index e50f1d8ac..acfa5fdbf 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -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)
+ "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))
+ ;; 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"))
+ (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))))
+ ;; 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
--
2.15.0