me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2014-07-20 14:25:08 +02:00
parent fcbf703efa
commit 8334cf5b5c
1 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
guix/scripts/system.scm
View File

@ -95,8 +95,8 @@
(store-lift show-what-to-build)) (store-lift show-what-to-build))
(define* (copy-closure item target (define* (copy-item item 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."
(mlet* %store-monad ((refs (references* item))) (mlet* %store-monad ((refs (references* item)))
(let ((dest (string-append target item)) (let ((dest (string-append target item))
@ -118,6 +118,18 @@
(return #t)))) (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 (define* (install os-drv target
#:key (log-port (current-output-port)) #:key (log-port (current-output-port))
grub? grub.cfg device) 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))) (mkdir-p (string-append target (%store-prefix)))
;; Copy items to the new store. ;; Copy items to the new store.
(sequence %store-monad (copy-closure to-copy target #:log-port log-port)))))
(map (cut copy-closure <> target #:log-port log-port)
to-copy))))))
(mlet* %store-monad ((os-dir -> (derivation->output-path os-drv)) (mlet* %store-monad ((os-dir -> (derivation->output-path os-drv))
(refs (references* os-dir)) (% (maybe-copy os-dir)))
(lst -> (delete-duplicates (cons os-dir refs)
string=?))
(to-copy (topologically-sorted* lst))
(% (maybe-copy to-copy)))
;; Create a bunch of additional files. ;; Create a bunch of additional files.
(format log-port "populating '~a'...~%" target) (format log-port "populating '~a'...~%" target)