Skip to content
Snippets Groups Projects
Commit 8334cf5b authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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.
parent fcbf703e
No related branches found
No related tags found
No related merge requests found
...@@ -95,8 +95,8 @@ (define show-what-to-build* ...@@ -95,8 +95,8 @@ (define show-what-to-build*
(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 @@ (define* (copy-closure item target ...@@ -118,6 +118,18 @@ (define* (copy-closure item target
(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 @@ (define (maybe-copy to-copy) ...@@ -136,16 +148,10 @@ (define (maybe-copy to-copy)
(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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment