summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-06 23:48:41 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-07 00:00:18 +0100
commit2cb658a9a7c491ee8ea13da9682170e40deb25ed (patch)
treedf55d006e676fe56a533c01864b32a902de65131 /guix
parenta4678c6ba18d8dbd79d931f80426eebf61be7ebe (diff)
describe: Add 'package-provenance'.
* guix/scripts/package.scm (package-provenance): Move to... * guix/describe.scm (package-provenance): ... here.
Diffstat (limited to 'guix')
-rw-r--r--guix/describe.scm43
-rw-r--r--guix/scripts/package.scm36
2 files changed, 42 insertions, 37 deletions
diff --git a/guix/describe.scm b/guix/describe.scm
index 670db63ce7..c31199c9cd 100644
--- a/guix/describe.scm
+++ b/guix/describe.scm
@@ -1,5 +1,5 @@
;;; 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.
;;;
@@ -19,11 +19,16 @@
(define-module (guix describe)
#:use-module (guix memoization)
#: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 (ice-9 match)
#:export (current-profile
current-profile-entries
- package-path-entries))
+ package-path-entries
+
+ package-provenance))
;;; Commentary:
;;;
@@ -73,3 +78,37 @@ process lives in, when applicable."
"/share/guile/site/"
(effective-version))))
(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) '()))))))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 0e70315708..efff511299 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -36,7 +36,7 @@
#:use-module (guix config)
#:use-module (guix scripts)
#:use-module (guix scripts build)
- #:autoload (guix describe) (current-profile-entries)
+ #:autoload (guix describe) (package-provenance)
#:use-module ((guix build utils)
#:select (directory-exists? mkdir-p))
#:use-module (ice-9 format)
@@ -552,40 +552,6 @@ upgrading, #f otherwise."
(output "out") ;XXX: wild guess
(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)
"Like 'package->manifest-entry', but attach PACKAGE provenance meta-data to
the resulting manifest entry."