Mirror of GNU Guix
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

139 lines
5.0 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (gnu packages)
  19. #:use-module (guix packages)
  20. #:use-module (guix utils)
  21. #:use-module (ice-9 ftw)
  22. #:use-module (srfi srfi-1)
  23. #:use-module (srfi srfi-26)
  24. #:use-module (srfi srfi-39)
  25. #:export (search-patch
  26. search-bootstrap-binary
  27. %patch-directory
  28. %bootstrap-binaries-path
  29. fold-packages
  30. find-packages-by-name))
  31. ;;; Commentary:
  32. ;;;
  33. ;;; General utilities for the software distribution---i.e., the modules under
  34. ;;; (gnu packages ...).
  35. ;;;
  36. ;;; Code:
  37. (define _ (cut gettext <> "guix"))
  38. ;; By default, we store patches and bootstrap binaries alongside Guile
  39. ;; modules. This is so that these extra files can be found without
  40. ;; requiring a special setup, such as a specific installation directory
  41. ;; and an extra environment variable. One advantage of this setup is
  42. ;; that everything just works in an auto-compilation setting.
  43. (define %patch-path
  44. (make-parameter
  45. (map (cut string-append <> "/gnu/packages/patches")
  46. %load-path)))
  47. (define %bootstrap-binaries-path
  48. (make-parameter
  49. (map (cut string-append <> "/gnu/packages/bootstrap")
  50. %load-path)))
  51. (define (search-patch file-name)
  52. "Search the patch FILE-NAME."
  53. (search-path (%patch-path) file-name))
  54. (define (search-bootstrap-binary file-name system)
  55. "Search the bootstrap binary FILE-NAME for SYSTEM."
  56. (search-path (%bootstrap-binaries-path)
  57. (string-append system "/" file-name)))
  58. (define %distro-module-directory
  59. ;; Absolute path of the (gnu packages ...) module root.
  60. (string-append (dirname (search-path %load-path "gnu/packages.scm"))
  61. "/packages"))
  62. (define (package-files)
  63. "Return the list of files that implement distro modules."
  64. (define prefix-len
  65. (string-length
  66. (dirname (dirname (search-path %load-path "gnu/packages.scm")))))
  67. (file-system-fold (const #t) ; enter?
  68. (lambda (path stat result) ; leaf
  69. (if (string-suffix? ".scm" path)
  70. (cons (substring path prefix-len) result)
  71. result))
  72. (lambda (path stat result) ; down
  73. result)
  74. (lambda (path stat result) ; up
  75. result)
  76. (const #f) ; skip
  77. (lambda (path stat errno result)
  78. (format (current-error-port)
  79. (_ "warning: cannot access `~a': ~a~%")
  80. path (strerror errno))
  81. result)
  82. '()
  83. %distro-module-directory
  84. stat))
  85. (define (package-modules)
  86. "Return the list of modules that provide packages for the distribution."
  87. (define not-slash
  88. (char-set-complement (char-set #\/)))
  89. (filter-map (lambda (path)
  90. (let ((name (map string->symbol
  91. (string-tokenize (string-drop-right path 4)
  92. not-slash))))
  93. (false-if-exception (resolve-interface name))))
  94. (package-files)))
  95. (define (fold-packages proc init)
  96. "Call (PROC PACKAGE RESULT) for each available package, using INIT as
  97. the initial value of RESULT."
  98. (fold (lambda (module result)
  99. (fold (lambda (var result)
  100. (if (package? var)
  101. (proc var result)
  102. result))
  103. result
  104. (module-map (lambda (sym var)
  105. (false-if-exception (variable-ref var)))
  106. module)))
  107. init
  108. (package-modules)))
  109. (define* (find-packages-by-name name #:optional version)
  110. "Return the list of packages with the given NAME. If VERSION is not #f,
  111. then only return packages whose version is equal to VERSION."
  112. (define right-package?
  113. (if version
  114. (lambda (p)
  115. (and (string=? (package-name p) name)
  116. (string=? (package-version p) version)))
  117. (lambda (p)
  118. (string=? (package-name p) name))))
  119. (fold-packages (lambda (package result)
  120. (if (right-package? package)
  121. (cons package result)
  122. result))
  123. '()))