diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-07-20 14:25:08 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-07-20 22:39:02 +0200 |
commit | 8334cf5b5c13d1afbc4ab746969deae1885d6550 (patch) | |
tree | d166da8e9281fc3518c8b2a79661dee9182fc443 /guix | |
parent | fcbf703efa575d0b791325c4e219fd11b07ac6c6 (diff) | |
download | gnu-guix-8334cf5b5c13d1afbc4ab746969deae1885d6550.tar gnu-guix-8334cf5b5c13d1afbc4ab746969deae1885d6550.tar.gz |
guix system: Factorize 'copy-closure'.
* guix/scripts/system.scm (copy-closure): Rename to...
(copy-item): ... this.
(copy-closure): New procedure.
(install): Use it, and remove redundant code.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/scripts/system.scm | 26 |
1 files changed, 16 insertions, 10 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 66ad9192c1..57f42215ee 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -95,8 +95,8 @@ (store-lift show-what-to-build)) -(define* (copy-closure item target - #:key (log-port (current-error-port))) +(define* (copy-item item 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)) @@ -118,6 +118,18 @@ (return #t)))) +(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)))) + (define* (install os-drv target #:key (log-port (current-output-port)) grub? grub.cfg device) @@ -136,16 +148,10 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG." (mkdir-p (string-append target (%store-prefix))) ;; Copy items to the new store. - (sequence %store-monad - (map (cut copy-closure <> target #:log-port log-port) - to-copy)))))) + (copy-closure to-copy target #:log-port log-port))))) (mlet* %store-monad ((os-dir -> (derivation->output-path os-drv)) - (refs (references* os-dir)) - (lst -> (delete-duplicates (cons os-dir refs) - string=?)) - (to-copy (topologically-sorted* lst)) - (% (maybe-copy to-copy))) + (% (maybe-copy os-dir))) ;; Create a bunch of additional files. (format log-port "populating '~a'...~%" target) |