summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-07-20 14:25:08 +0200
committerLudovic Courtès <ludo@gnu.org>2014-07-20 22:39:02 +0200
commit8334cf5b5c13d1afbc4ab746969deae1885d6550 (patch)
treed166da8e9281fc3518c8b2a79661dee9182fc443
parentfcbf703efa575d0b791325c4e219fd11b07ac6c6 (diff)
downloadguix-patches-8334cf5b5c13d1afbc4ab746969deae1885d6550.tar
guix-patches-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.
-rw-r--r--guix/scripts/system.scm26
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)