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:
parent
1fafa2f587
commit
e4ecd51e23
@ -107,10 +107,10 @@ 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)))
|
||||
"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)
|
||||
@ -131,23 +131,20 @@ BODY..., and restore them."
|
||||
(unless (register-path item
|
||||
#:prefix target
|
||||
#:state-directory state
|
||||
#:references refs)
|
||||
#:references references)
|
||||
(leave (G_ "failed to register '~a' under '~a'~%")
|
||||
item target))
|
||||
|
||||
(return #t))))
|
||||
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
|
||||
|
Loading…
Reference in New Issue
Block a user