amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

describe: Add package-channels.

Browse source 
* guix/describe.scm (package-channels): New procedure.
(package-provenance): Rewrite using package-channels procedure.
This commit is contained in:
Mathieu Othacehe 2021-02-23 14:24:39 +01:00
parent 3fef3cb8d2
commit 17fbd5a5c9
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 40 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

64
guix/describe.scm
View file

@ -33,6 +33,7 @@
package-path-entries package-path-entries
package-provenance package-provenance
package-channels
manifest-entry-with-provenance manifest-entry-with-provenance
manifest-entry-provenance)) manifest-entry-provenance))
@ -144,6 +145,26 @@ when applicable."
"/site-ccache"))) "/site-ccache")))
(current-channel-entries)))) (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) (define (package-provenance package)
"Return the provenance of PACKAGE as an sexp for use as the 'provenance' "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." 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) (('source value) value)
(_ #f))) (_ #f)))
(match (and=> (package-location package) location-file) (let* ((channels (package-channels package))
(#f #f) (names (map (compose symbol->string channel-name) channels)))
(file ;; Always store information about the 'guix' channel and
(let ((file (if (string-prefix? "/" file) ;; optionally about the specific channel FILE comes from.
file (or (let ((main (and=> (find (lambda (entry)
(search-path %load-path file)))) (string=? "guix"
(and file (manifest-entry-name entry)))
(string-prefix? (%store-prefix) file) (current-profile-entries))
entry-source))
;; Always store information about the 'guix' channel and (extra (any (lambda (entry)
;; optionally about the specific channel FILE comes from. (let ((item (manifest-entry-item entry))
(or (let ((main (and=> (find (lambda (entry) (name (manifest-entry-name entry)))
(string=? "guix" (and (member name names)
(manifest-entry-name entry))) (not (string=? name "guix"))
(current-profile-entries)) (entry-source entry))))
entry-source)) (current-profile-entries))))
(extra (any (lambda (entry) (and main
(let ((item (manifest-entry-item entry))) `(,main
(and (string-prefix? item file) ,@(if extra (list extra) '())))))))
(entry-source entry))))
(current-profile-entries))))
(and main
`(,main
,@(if extra (list extra) '()))))))))))
(define (manifest-entry-with-provenance entry) (define (manifest-entry-with-provenance entry)
"Return ENTRY with an additional 'provenance' property if it's not already "Return ENTRY with an additional 'provenance' property if it's not already