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.
This commit is contained in:
Ludovic Courtès 2014-07-20 14:25:08 +02:00
parent fcbf703efa
commit 8334cf5b5c
1 changed files with 16 additions and 10 deletions

View File

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