diff options
| author | Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> | 2018-12-19 14:36:29 +0100 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2018-12-19 23:46:38 +0100 |
| commit | 80eebee9f7578ed096fed4cb6adfcbae3cfefc58 (patch) | |
| tree | b9ad4a2dbb2dbaef917a23359407974ae7477d5f /guix/ui.scm | |
| parent | 0485717ee94e7f161d072f017edce5d35df49c81 (diff) | |
| download | gnu-guix-80eebee9f7578ed096fed4cb6adfcbae3cfefc58.tar gnu-guix-80eebee9f7578ed096fed4cb6adfcbae3cfefc58.tar.gz | |
ui: Report profile hooks separately.
* guix/ui.scm (profile-hook-derivation?): New procedure.
(show-what-to-build): Distinguish among BUILD derivations that match
'profile-hook-derivation?'. Report them separately.
* guix/status.scm (hook-message): New procedure.
(print-build-event): Display profile hooks with readable hook name.
* guix/profiles.scm (info-dir-file, ghc-package-cache-file,
ca-certificate-bundle, glib-schemas, gtk-icon-themes, gtk-im-modules,
xdg-desktop-database, xdg-mime-database, fonts-dir-file, manual-database):
Augment derivation with "type" and "hook" properties.
Diffstat (limited to 'guix/ui.scm')
| -rw-r--r-- | guix/ui.scm | 46 |
1 files changed, 40 insertions, 6 deletions
diff --git a/guix/ui.scm b/guix/ui.scm index 148c181039..44336ee8fd 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -829,6 +829,12 @@ warning." ('graft #t) (_ #f))) +(define (profile-hook-derivation? drv) + "Return true if DRV is definitely a profile hook derivation, false otherwise." + (match (assq-ref (derivation-properties drv) 'type) + ('profile-hook #t) + (_ #f))) + (define* (show-what-to-build store drv #:key dry-run? (use-substitutes? #t) (mode (build-mode normal))) @@ -879,10 +885,28 @@ report what is prerequisites are available for download." substitutable-references download)))) download)) - ((graft build) - (partition (compose graft-derivation? - read-derivation-from-file) - build))) + ((graft hook build) + (match (fold (lambda (file acc) + (let ((drv (read-derivation-from-file file))) + (match acc + ((#:graft graft #:hook hook #:build build) + (cond + ((graft-derivation? drv) + `(#:graft ,(cons file graft) + #:hook ,hook + #:build ,build)) + ((profile-hook-derivation? drv) + `(#:graft ,graft + #:hook ,(cons file hook) + #:build ,build)) + (else + `(#:graft ,graft + #:hook ,hook + #:build ,(cons file build)))))))) + '(#:graft () #:hook () #:build ()) + build) + ((#:graft graft #:hook hook #:build build) + (values graft hook build))))) (define installed-size (reduce + 0 (map substitutable-nar-size download))) @@ -920,7 +944,12 @@ report what is prerequisites are available for download." (N_ "~:[The following graft would be made:~%~{ ~a~%~}~;~]" "~:[The following grafts would be made:~%~{ ~a~%~}~;~]" (length graft)) - (null? graft) graft)) + (null? graft) graft) + (format (current-error-port) + (N_ "~:[The following profile hook would be built:~%~{ ~a~%~}~;~]" + "~:[The following profile hooks would be built:~%~{ ~a~%~}~;~]" + (length hook)) + (null? hook) hook)) (begin (format (current-error-port) (N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]" @@ -945,7 +974,12 @@ report what is prerequisites are available for download." (N_ "~:[The following graft will be made:~%~{ ~a~%~}~;~]" "~:[The following grafts will be made:~%~{ ~a~%~}~;~]" (length graft)) - (null? graft) graft))) + (null? graft) graft) + (format (current-error-port) + (N_ "~:[The following profile hook will be built:~%~{ ~a~%~}~;~]" + "~:[The following profile hooks will be built:~%~{ ~a~%~}~;~]" + (length hook)) + (null? hook) hook))) (check-available-space installed-size) |