guix system: Simplify closure copy.

* 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'.
This commit is contained in:
Ludovic Courtès 2017-11-30 14:17:24 +01:00
parent 1fafa2f587
commit e4ecd51e23
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 32 deletions

View File

@ -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