X-Git-Url: http://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/b4d7689f9255b93b9ea02e01dc490f1416f77782..02d1bc6b58bb0df5ac14f5042063b629992b6cd9:/gnu/packages.scm diff --git a/gnu/packages.scm b/gnu/packages.scm index e484d9754f..d22c992bb1 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016, 2017 Alex Kost @@ -30,11 +30,12 @@ #: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) @@ -45,16 +46,15 @@ #: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 @@ -73,18 +73,13 @@ ;;; ;;; 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") @@ -106,22 +101,6 @@ 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. @@ -159,23 +138,26 @@ flags." ;; 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 @@ -187,6 +169,29 @@ flags." directory)) %load-path))) +;; This procedure is used by Emacs-Guix up to 0.5.1.1, so keep it for now. +;; See . +(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: @@ -223,9 +228,7 @@ package module." #: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)))) @@ -366,6 +369,9 @@ VERSION." (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. @@ -388,9 +394,7 @@ reducing the memory footprint." ,(module-name module) ,symbol ,(package-outputs package) - ,(->bool - (member (%current-system) - (package-supported-systems package))) + ,(->bool (supported-package? package)) ,(->bool (package-superseded package)) ,@(let ((loc (package-location package))) (if loc @@ -510,14 +514,18 @@ optionally contain a version number and an output name, as in these examples: 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)