diff --git a/guix/describe.scm b/guix/describe.scm index 03569b1db4..d1bc397037 100644 --- a/guix/describe.scm +++ b/guix/describe.scm @@ -33,6 +33,7 @@ (define-module (guix describe) package-path-entries package-provenance + package-channels manifest-entry-with-provenance manifest-entry-provenance)) @@ -144,6 +145,26 @@ (define (package-path-entries) "/site-ccache"))) (current-channel-entries)))) +(define (package-channels package) + "Return the list of channels providing PACKAGE or an empty list if it could +not be determined." + (match (and=> (package-location package) location-file) + (#f '()) + (file + (let ((file (if (string-prefix? "/" file) + file + (search-path %load-path file)))) + (and file + (string-prefix? (%store-prefix) file) + + (filter-map + (lambda (entry) + (let ((item (manifest-entry-item entry))) + (and (or (string-prefix? item file) + (string=? "guix" (manifest-entry-name entry))) + (manifest-entry-channel entry)))) + (current-profile-entries))))))) + (define (package-provenance package) "Return the provenance of PACKAGE as an sexp for use as the 'provenance' property of manifest entries, or #f if it could not be determined." @@ -153,30 +174,25 @@ (define (entry-source entry) (('source value) value) (_ #f))) - (match (and=> (package-location package) location-file) - (#f #f) - (file - (let ((file (if (string-prefix? "/" file) - file - (search-path %load-path file)))) - (and file - (string-prefix? (%store-prefix) file) - - ;; Always store information about the 'guix' channel and - ;; optionally about the specific channel FILE comes from. - (or (let ((main (and=> (find (lambda (entry) - (string=? "guix" - (manifest-entry-name entry))) - (current-profile-entries)) - entry-source)) - (extra (any (lambda (entry) - (let ((item (manifest-entry-item entry))) - (and (string-prefix? item file) - (entry-source entry)))) - (current-profile-entries)))) - (and main - `(,main - ,@(if extra (list extra) '())))))))))) + (let* ((channels (package-channels package)) + (names (map (compose symbol->string channel-name) channels))) + ;; Always store information about the 'guix' channel and + ;; optionally about the specific channel FILE comes from. + (or (let ((main (and=> (find (lambda (entry) + (string=? "guix" + (manifest-entry-name entry))) + (current-profile-entries)) + entry-source)) + (extra (any (lambda (entry) + (let ((item (manifest-entry-item entry)) + (name (manifest-entry-name entry))) + (and (member name names) + (not (string=? name "guix")) + (entry-source entry)))) + (current-profile-entries)))) + (and main + `(,main + ,@(if extra (list extra) '()))))))) (define (manifest-entry-with-provenance entry) "Return ENTRY with an additional 'provenance' property if it's not already