nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

store-copy: Display a progress bar when copying store items. 

* guix/build/store-copy.scm (populate-store): Add #:log-port parameter.
Use 'progress-reporter/bar' to report progress.
This commit is contained in:
Ludovic Courtès 2018-09-23 22:24:07 +02:00
parent c122a2e509
commit a387b0bebb
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
guix/build/store-copy.scm
View File

@ -19,6 +19,7 @@
(define-module (guix build store-copy) (define-module (guix build store-copy)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (guix progress)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -167,7 +168,8 @@ REFERENCE-GRAPHS, a list of reference-graph files."
(reduce + 0 (map file-size items))) (reduce + 0 (map file-size items)))
(define* (populate-store reference-graphs target) (define* (populate-store reference-graphs target
#:key (log-port (current-error-port)))
"Populate the store under directory TARGET with the items specified in "Populate the store under directory TARGET with the items specified in
REFERENCE-GRAPHS, a list of reference-graph files." REFERENCE-GRAPHS, a list of reference-graph files."
(define store (define store
@ -183,9 +185,20 @@ REFERENCE-GRAPHS, a list of reference-graph files."
(mkdir-p store) (mkdir-p store)
(chmod store #o1775) (chmod store #o1775)
(let* ((things (things-to-copy))
(len (length things))
(progress (progress-reporter/bar len
(format #f "copying ~a store items"
len)
log-port)))
(call-with-progress-reporter progress
(lambda (report)
(for-each (lambda (thing) (for-each (lambda (thing)
(copy-recursively thing (copy-recursively thing
(string-append target thing))) (string-append target thing)
(things-to-copy))) #:log (%make-void-port "w"))
(report))
things)))))
;;; store-copy.scm ends here ;;; store-copy.scm ends here