summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-02-23 14:24:39 +0100
committerMathieu Othacehe <othacehe@gnu.org>2021-02-25 10:11:25 +0100
commit17fbd5a5c9c09ff54ce95985dcbcdd1b9c60a34e (patch)
tree4030a27cc6614ad70ce2999f9104eb9605022a2a /guix
parent3fef3cb8d2d9600764f5447f66dd2b4576dd0a61 (diff)
describe: Add package-channels.
* guix/describe.scm (package-channels): New procedure. (package-provenance): Rewrite using package-channels procedure.
Diffstat (limited to 'guix')
-rw-r--r--guix/describe.scm64
1 files changed, 40 insertions, 24 deletions
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 @@
package-path-entries
package-provenance
+ package-channels
manifest-entry-with-provenance
manifest-entry-provenance))
@@ -144,6 +145,26 @@ when applicable."
"/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 @@ property of manifest entries, or #f if it could not be determined."
(('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