;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2016
, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Guix.
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix utils)
+ #:use-module (guix memoization)
#:use-module (guix combinators)
#:use-module ((guix build utils)
#:select ((package-name->name+version
#:use-module (srfi srfi-39)
#:export (search-patch
search-patches
+ search-auxiliary-file
search-bootstrap-binary
%patch-path
+ %auxiliary-files-path
%bootstrap-binaries-path
%package-module-path
fold-packages
+ scheme-modules ;XXX: for lack of a better place
find-packages-by-name
find-best-packages-by-name
;;;
;;; Code:
-;; By default, we store patches and bootstrap binaries 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.
+;; By default, we store patches, auxiliary files and bootstrap binaries
+;; 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")
+ %load-path)))
+
+(define (search-auxiliary-file file-name)
+ "Search the auxiliary FILE-NAME. Return #f if not found."
+ (search-path (%auxiliary-files-path) file-name))
+
(define (search-patch file-name)
"Search the patch FILE-NAME. Raise an error if not found."
(or (search-path (%patch-path) file-name)
(map string->symbol
(string-tokenize (string-drop-right file 4) not-slash)))))
-(define* (package-modules directory #:optional sub-directory)
- "Return the list of modules that provide packages for the distribution.
+(define* (scheme-modules directory #:optional sub-directory)
+ "Return the list of Scheme modules available under DIRECTORY.
Optionally, narrow the search to SUB-DIRECTORY."
(define prefix-len
(string-length directory))
(fold-right (lambda (spec result)
(match spec
((? string? directory)
- (append (package-modules directory) result))
+ (append (scheme-modules directory) result))
((directory . sub-directory)
- (append (package-modules directory sub-directory)
+ (append (scheme-modules directory sub-directory)
result))))
'()
path))
(fold2 (lambda (module result seen)
(fold2 (lambda (var result seen)
(if (and (package? var)
- (not (vhash-assq var seen)))
+ (not (vhash-assq var seen))
+ (not (hidden-package? var)))
(values (proc var result)
(vhash-consq var #t seen))
(values result seen)))
matching)))))
(define find-newest-available-packages
- (memoize
- (lambda ()
- "Return a vhash keyed by package names, and with
+ (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."
- ;; FIXME: Currently, the preferred package is whichever one
- ;; was found last by 'fold-packages'. Find a better solution.
- (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))))
+ ;; FIXME: Currently, the preferred package is whichever one
+ ;; was found last by 'fold-packages'. Find a better solution.
+ (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 (find-best-packages-by-name name version)
"If version is #f, return the list of packages named NAME with the highest
((pkg . pkg*)
(unless (null? pkg*)
(warning (_ "ambiguous package specification `~a'~%") spec)
- (warning (_ "choosing ~a from ~a~%")
- (package-full-name pkg)
+ (warning (_ "choosing ~a@~a from ~a~%")
+ (package-name pkg) (package-version pkg)
(location->string (package-location pkg))))
(when fallback?
(warning (_ "deprecated NAME-VERSION syntax; \
use NAME@VERSION instead~%")))
- pkg)
- (_
+
+ (match (package-superseded pkg)
+ ((? package? new)
+ (info (_ "package '~a' has been superseded by '~a'~%")
+ (package-name pkg) (package-name new))
+ new)
+ (#f
+ pkg)))
+ (x
(if version
(leave (_ "~A: package not found for version ~a~%") name version)
(if (not fallback?)
HCoop / jackhill / guix / guix.git / blobdiff