From ce2ba3431a71effa2f9f9f888f0e8ad9e670cb72 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 22 Feb 2021 23:33:47 +0100 Subject: describe: Fix typo in 'manifest-entry-with-provenance'. * guix/describe.scm (manifest-entry-with-provenance): Fix first argument to 'assq'. --- guix/describe.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/describe.scm') diff --git a/guix/describe.scm b/guix/describe.scm index 6a31c707f0..03569b1db4 100644 --- a/guix/describe.scm +++ b/guix/describe.scm @@ -182,7 +182,7 @@ property of manifest entries, or #f if it could not be determined." "Return ENTRY with an additional 'provenance' property if it's not already there." (let ((properties (manifest-entry-properties entry))) - (if (assq 'properties properties) + (if (assq 'provenance properties) entry (let ((item (manifest-entry-item entry))) (manifest-entry -- cgit v1.2.3 From 17fbd5a5c9c09ff54ce95985dcbcdd1b9c60a34e Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 23 Feb 2021 14:24:39 +0100 Subject: describe: Add package-channels. * guix/describe.scm (package-channels): New procedure. (package-provenance): Rewrite using package-channels procedure. --- guix/describe.scm | 64 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 40 insertions(+), 24 deletions(-) (limited to 'guix/describe.scm') 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 -- cgit v1.2.3 From b6c7e5af026f2d0fdbcc96a7815e15008ef0eb1c Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Thu, 25 Feb 2021 10:19:32 +0100 Subject: describe: Add missing include. This is a follow-up of 17fbd5a5c9c09ff54ce95985dcbcdd1b9c60a34e. * guix/describe.scm: Add "channel-name" to (guix channels) autoload. --- guix/describe.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix/describe.scm') diff --git a/guix/describe.scm b/guix/describe.scm index d1bc397037..46448de311 100644 --- a/guix/describe.scm +++ b/guix/describe.scm @@ -23,7 +23,9 @@ #:use-module ((guix utils) #:select (location-file)) #:use-module ((guix store) #:select (%store-prefix store-path?)) #:use-module ((guix config) #:select (%state-directory)) - #:autoload (guix channels) (sexp->channel manifest-entry-channel) + #:autoload (guix channels) (channel-name + sexp->channel + manifest-entry-channel) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (current-profile -- cgit v1.2.3 From 4dfce0115f3d09945bf9f5a0775ffbf20ba39c79 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Thu, 25 Feb 2021 10:24:11 +0100 Subject: describe: Make sure package-channels always returns a list. * guix/describe.scm (package-channels): Return an empty list if the file origin could not be determined. --- guix/describe.scm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'guix/describe.scm') diff --git a/guix/describe.scm b/guix/describe.scm index 46448de311..0683ad8a27 100644 --- a/guix/describe.scm +++ b/guix/describe.scm @@ -156,16 +156,16 @@ not be determined." (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))))))) + (if (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' -- cgit v1.2.3