;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
#:select ((package-name->name+version
. hyphen-separated-name->name+version)
mkdir-p))
- #:autoload (guix profiles) (packages->manifest)
+ #:use-module (guix profiles)
#:use-module (guix describe)
+ #:use-module (guix deprecation)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
- #:autoload (ice-9 binary-ports) (put-bytevector)
+ #:use-module (ice-9 binary-ports)
#:autoload (system base compile) (compile)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:export (search-patch
search-patches
search-auxiliary-file
- search-bootstrap-binary
%patch-path
%auxiliary-files-path
- %bootstrap-binaries-path
%package-module-path
%default-package-module-path
fold-packages
fold-available-packages
+ find-newest-available-packages
find-packages-by-name
find-package-locations
find-best-packages-by-name
;;;
;;; Code:
-;; By default, we store patches, auxiliary files and bootstrap binaries
+;; By default, we store patches and auxiliary files
;; alongside Guile modules. This is so that these extra files can be
;; found without requiring a special setup, such as a specific
;; installation directory and an extra environment variable. One
;; advantage of this setup is that everything just works in an
;; auto-compilation setting.
-(define %bootstrap-binaries-path
- (make-parameter
- (map (cut string-append <> "/gnu/packages/bootstrap")
- %load-path)))
-
(define %auxiliary-files-path
(make-parameter
(map (cut string-append <> "/gnu/packages/aux-files")
FILE-NAME found in %PATCH-PATH."
(list (search-patch file-name) ...))
-(define (search-bootstrap-binary file-name system)
- "Search the bootstrap binary FILE-NAME for SYSTEM. Raise an error if not
-found."
- ;; On x86_64 always use the i686 binaries.
- (let ((system (match system
- ("x86_64-linux" "i686-linux")
- (_ system))))
- (or (search-path (%bootstrap-binaries-path)
- (string-append system "/" file-name))
- (raise (condition
- (&message
- (message
- (format #f (G_ "could not find bootstrap binary '~a' \
-for system '~a'")
- file-name system))))))))
-
(define %distro-root-directory
;; Absolute file name of the module hierarchy. Since (gnu packages …) might
;; live in a directory different from (guix), try to get the best match.
;; Search path for package modules. Each item must be either a directory
;; name or a pair whose car is a directory and whose cdr is a sub-directory
;; to narrow the search.
- (let* ((not-colon (char-set-complement (char-set #\:)))
- (environment (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "")
- not-colon))
- (channels (package-path-entries)))
+ (let*-values (((not-colon)
+ (char-set-complement (char-set #\:)))
+ ((environment)
+ (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "")
+ not-colon))
+ ((channels-scm channels-go)
+ (package-path-entries)))
;; Automatically add channels and items from $GUIX_PACKAGE_PATH to Guile's
;; search path. For historical reasons, $GUIX_PACKAGE_PATH goes to the
;; front; channels go to the back so that they don't override Guix' own
;; modules.
(set! %load-path
- (append environment %load-path channels))
+ (append environment %load-path channels-scm))
(set! %load-compiled-path
- (append environment %load-compiled-path channels))
+ (append environment %load-compiled-path channels-go))
(make-parameter
(append environment
%default-package-module-path
- channels))))
+ channels-scm))))
(define %patch-path
;; Define it after '%package-module-path' so that '%load-path' contains user
directory))
%load-path)))
+;; This procedure is used by Emacs-Guix up to 0.5.1.1, so keep it for now.
+;; See <https://github.com/alezost/guix.el/issues/30>.
+(define-deprecated find-newest-available-packages
+ find-packages-by-name
+ (mlambda ()
+ "Return a vhash keyed by package names, and with
+associated values of the form
+
+ (newest-version newest-package ...)
+
+where the preferred package is listed first."
+ (fold-packages (lambda (p r)
+ (let ((name (package-name p))
+ (version (package-version p)))
+ (match (vhash-assoc name r)
+ ((_ newest-so-far . pkgs)
+ (case (version-compare version newest-so-far)
+ ((>) (vhash-cons name `(,version ,p) r))
+ ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
+ ((<) r)))
+ (#f (vhash-cons name `(,version ,p) r)))))
+ vlist-null)))
+
(define (fold-available-packages proc init)
"Fold PROC over the list of available packages. For each available package,
PROC is called along these lines:
#:outputs (package-outputs package)
#:location (package-location package)
#:supported?
- (->bool
- (member (%current-system)
- (package-supported-systems package)))
+ (->bool (supported-package? package))
#:deprecated?
(->bool
(package-superseded package))))
(string=? (package-version p) highest))
matches))))))
+;; Prevent Guile 3 from inlining this procedure so we can mock it in tests.
+(set! find-best-packages-by-name find-best-packages-by-name)
+
(define (generate-package-cache directory)
"Generate under DIRECTORY a cache of all the available packages.
(define cache-file
(string-append directory %package-cache-file))
- (define (expand-cache module symbol variable result)
+ (define (expand-cache module symbol variable result+seen)
(match (false-if-exception (variable-ref variable))
((? package? package)
- (if (hidden-package? package)
- result
- (cons `#(,(package-name package)
- ,(package-version package)
- ,(module-name module)
- ,symbol
- ,(package-outputs package)
- ,(->bool (member (%current-system)
- (package-supported-systems package)))
- ,(->bool (package-superseded package))
- ,@(let ((loc (package-location package)))
- (if loc
- `(,(location-file loc)
- ,(location-line loc)
- ,(location-column loc))
- '(#f #f #f))))
- result)))
+ (match result+seen
+ ((result . seen)
+ (if (or (vhash-assq package seen)
+ (hidden-package? package))
+ (cons result seen)
+ (cons (cons `#(,(package-name package)
+ ,(package-version package)
+ ,(module-name module)
+ ,symbol
+ ,(package-outputs package)
+ ,(->bool (supported-package? package))
+ ,(->bool (package-superseded package))
+ ,@(let ((loc (package-location package)))
+ (if loc
+ `(,(location-file loc)
+ ,(location-line loc)
+ ,(location-column loc))
+ '(#f #f #f))))
+ result)
+ (vhash-consq package #t seen))))))
(_
- result)))
+ result+seen)))
(define exp
- (fold-module-public-variables* expand-cache '()
- (all-modules (%package-module-path)
- #:warn
- warn-about-load-error)))
+ (first
+ (fold-module-public-variables* expand-cache
+ (cons '() vlist-null)
+ (all-modules (%package-module-path)
+ #:warn
+ warn-about-load-error))))
(mkdir-p (dirname cache-file))
(call-with-output-file cache-file
guile@2.0.9:debug
If SPEC does not specify a version number, return the preferred newest
-version; if SPEC does not specify an output, return OUTPUT."
+version; if SPEC does not specify an output, return OUTPUT.
+
+When OUTPUT is false and SPEC does not specify any output, return #f as the
+output."
(let-values (((name version sub-drv)
(package-specification->name+version+output spec output)))
(match (%find-package spec name version)
(#f
(values #f #f))
(package
- (if (member sub-drv (package-outputs package))
+ (if (or (and (not output) (not sub-drv))
+ (member sub-drv (package-outputs package)))
(values package sub-drv)
(leave (G_ "package `~a' lacks output `~a'~%")
(package-full-name package)