1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (gnu packages)
21 #:use-module (guix packages)
22 #:use-module (guix ui)
23 #:use-module (guix utils)
24 #:use-module (ice-9 ftw)
25 #:use-module (ice-9 vlist)
26 #:use-module (ice-9 match)
27 #:use-module (srfi srfi-1)
28 #:use-module (srfi srfi-26)
29 #:use-module (srfi srfi-39)
30 #:export (search-patch
31 search-bootstrap-binary
33 %bootstrap-binaries-path
36 find-newest-available-packages))
40 ;;; General utilities for the software distribution---i.e., the modules under
41 ;;; (gnu packages ...).
45 (define _ (cut gettext <> "guix"))
47 ;; By default, we store patches and bootstrap binaries alongside Guile
48 ;; modules. This is so that these extra files can be found without
49 ;; requiring a special setup, such as a specific installation directory
50 ;; and an extra environment variable. One advantage of this setup is
51 ;; that everything just works in an auto-compilation setting.
55 (map (cut string-append <> "/gnu/packages/patches")
58 (define %bootstrap-binaries-path
60 (map (cut string-append <> "/gnu/packages/bootstrap")
63 (define (search-patch file-name)
64 "Search the patch FILE-NAME."
65 (search-path (%patch-path) file-name))
67 (define (search-bootstrap-binary file-name system)
68 "Search the bootstrap binary FILE-NAME for SYSTEM."
69 (search-path (%bootstrap-binaries-path)
70 (string-append system "/" file-name)))
72 (define %distro-module-directory
73 ;; Absolute path of the (gnu packages ...) module root.
74 (string-append (dirname (search-path %load-path "gnu/packages.scm"))
77 (define (package-files)
78 "Return the list of files that implement distro modules."
81 (dirname (dirname (search-path %load-path "gnu/packages.scm")))))
83 (file-system-fold (const #t) ; enter?
84 (lambda (path stat result) ; leaf
85 (if (string-suffix? ".scm" path)
86 (cons (substring path prefix-len) result)
88 (lambda (path stat result) ; down
90 (lambda (path stat result) ; up
93 (lambda (path stat errno result)
94 (warning (_ "cannot access `~a': ~a~%")
95 path (strerror errno))
98 %distro-module-directory
101 (define (package-modules)
102 "Return the list of modules that provide packages for the distribution."
104 (char-set-complement (char-set #\/)))
106 (filter-map (lambda (path)
107 (let ((name (map string->symbol
108 (string-tokenize (string-drop-right path 4)
110 (false-if-exception (resolve-interface name))))
113 (define (fold-packages proc init)
114 "Call (PROC PACKAGE RESULT) for each available package, using INIT as
115 the initial value of RESULT. It is guaranteed to never traverse the
117 (identity ; discard second return value
118 (fold2 (lambda (module result seen)
119 (fold2 (lambda (var result seen)
120 (if (and (package? var)
121 (not (vhash-assq var seen)))
122 (values (proc var result)
123 (vhash-consq var #t seen))
124 (values result seen)))
127 (module-map (lambda (sym var)
128 (false-if-exception (variable-ref var)))
134 (define* (find-packages-by-name name #:optional version)
135 "Return the list of packages with the given NAME. If VERSION is not #f,
136 then only return packages whose version is equal to VERSION."
137 (define right-package?
140 (and (string=? (package-name p) name)
141 (string=? (package-version p) version)))
143 (string=? (package-name p) name))))
145 (fold-packages (lambda (package result)
146 (if (right-package? package)
147 (cons package result)
151 (define (find-newest-available-packages)
152 "Return a vhash keyed by package names, and with
153 associated values of the form
155 (newest-version newest-package ...)
157 where the preferred package is listed first."
159 ;; FIXME: Currently, the preferred package is whichever one
160 ;; was found last by 'fold-packages'. Find a better solution.
161 (fold-packages (lambda (p r)
162 (let ((name (package-name p))
163 (version (package-version p)))
164 (match (vhash-assoc name r)
165 ((_ newest-so-far . pkgs)
166 (case (version-compare version newest-so-far)
167 ((>) (vhash-cons name `(,version ,p) r))
168 ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
170 (#f (vhash-cons name `(,version ,p) r)))))