nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

describe: Add 'package-provenance'. 

* guix/scripts/package.scm (package-provenance): Move to...
* guix/describe.scm (package-provenance): ... here.
This commit is contained in:
Ludovic Courtès 2019-03-06 23:48:41 +01:00
parent a4678c6ba1
commit 2cb658a9a7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 42 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
guix/describe.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,11 +19,16 @@
(define-module (guix describe) (define-module (guix describe)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix packages)
#:use-module ((guix utils) #:select (location-file))
#:use-module ((guix store) #:select (%store-prefix))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (current-profile #:export (current-profile
current-profile-entries current-profile-entries
package-path-entries)) package-path-entries
package-provenance))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -73,3 +78,37 @@ process lives in, when applicable."
"/share/guile/site/" "/share/guile/site/"
(effective-version)))) (effective-version))))
(current-profile-entries)))) (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."
(define (entry-source entry)
(match (assq 'source
(manifest-entry-properties 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) '()))))))))))

36
guix/scripts/package.scm
View File

@ -36,7 +36,7 @@
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:autoload (guix describe) (current-profile-entries) #:autoload (guix describe) (package-provenance)
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (directory-exists? mkdir-p)) #:select (directory-exists? mkdir-p))
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -552,40 +552,6 @@ upgrading, #f otherwise."
(output "out") ;XXX: wild guess (output "out") ;XXX: wild guess
(item item)))) (item item))))
(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."
(define (entry-source entry)
(match (assq 'source
(manifest-entry-properties 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) '()))))))))))
(define (package->manifest-entry* package output) (define (package->manifest-entry* package output)
"Like 'package->manifest-entry', but attach PACKAGE provenance meta-data to "Like 'package->manifest-entry', but attach PACKAGE provenance meta-data to
the resulting manifest entry." the resulting manifest entry."