guix/guix
3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

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
Show stats 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-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