nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
master
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
guix/scripts/system.scm
View File

@ -107,10 +107,10 @@ BODY..., and restore them."
(store-lift topologically-sorted)) (store-lift topologically-sorted))
(define* (copy-item item target (define* (copy-item item references target
#:key (log-port (current-error-port))) #:key (log-port (current-error-port)))
"Copy ITEM to the store under root directory TARGET and register it." "Copy ITEM to the store under root directory TARGET and register it with
(mlet* %store-monad ((refs (references* item))) REFERENCES as its set of references."
(let ((dest (string-append target item)) (let ((dest (string-append target item))
(state (string-append target "/var/guix"))) (state (string-append target "/var/guix")))
(format log-port "copying '~a'...~%" item) (format log-port "copying '~a'...~%" item)
@ -131,23 +131,20 @@ BODY..., and restore them."
(unless (register-path item (unless (register-path item
#:prefix target #:prefix target
#:state-directory state #:state-directory state
#:references refs) #:references references)
(leave (G_ "failed to register '~a' under '~a'~%") (leave (G_ "failed to register '~a' under '~a'~%")
item target)) item target))))
(return #t))))
(define* (copy-closure item target (define* (copy-closure item target
#:key (log-port (current-error-port))) #:key (log-port (current-error-port)))
"Copy ITEM and all its dependencies to the store under root directory "Copy ITEM and all its dependencies to the store under root directory
TARGET, and register them." TARGET, and register them."
(mlet* %store-monad ((refs (references* item)) (mlet* %store-monad ((to-copy (topologically-sorted* (list item)))
(to-copy (topologically-sorted* (refs (mapm %store-monad references* to-copy)))
(delete-duplicates (cons item refs) (for-each (cut copy-item <> <> target #:log-port log-port)
string=?)))) to-copy refs)
(sequence %store-monad
(map (cut copy-item <> target #:log-port log-port) (return *unspecified*)))
to-copy))))
(define* (install-bootloader installer-drv (define* (install-bootloader installer-drv
#:key #:key