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.

126 lines
4.5 KiB

  1. ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
  2. ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of Guix.
  5. ;;;
  6. ;;; 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. ;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (distro)
  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. find-packages-by-name))
  29. ;;; Commentary:
  30. ;;;
  31. ;;; General utilities for the software distribution---i.e., the modules under
  32. ;;; (distro ...).
  33. ;;;
  34. ;;; Code:
  35. (define _ (cut gettext <> "guix"))
  36. (define not-colon
  37. ;; The char set that contains all the characters but `:'.
  38. (char-set-complement (char-set #\:)))
  39. (define %patch-path
  40. (make-parameter
  41. (or (and=> (getenv "DISTRO_PATCH_PATH")
  42. (cut string-tokenize <> not-colon))
  43. (compile-time-value
  44. (list (getenv "DISTRO_INSTALLED_PATCH_DIRECTORY"))))))
  45. (define %bootstrap-binaries-path
  46. (make-parameter
  47. (or (and=> (getenv "DISTRO_BOOTSTRAP_PATH")
  48. (cut string-tokenize <> not-colon))
  49. (compile-time-value
  50. (list (getenv "DISTRO_INSTALLED_BOOTSTRAP_DIRECTORY"))))))
  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 (distro ...) module root.
  60. (string-append (dirname (search-path %load-path "distro.scm"))
  61. "/distro/packages"))
  62. (define (package-files)
  63. "Return the list of files that implement distro modules."
  64. (define prefix-len
  65. (string-length (dirname (search-path %load-path "distro.scm"))))
  66. (file-system-fold (const #t) ; enter?
  67. (lambda (path stat result) ; leaf
  68. (if (string-suffix? ".scm" path)
  69. (cons (substring path prefix-len) result)
  70. result))
  71. (lambda (path stat result) ; down
  72. result)
  73. (lambda (path stat result) ; up
  74. result)
  75. (const #f) ; skip
  76. (lambda (path stat errno result)
  77. (format (current-error-port)
  78. (_ "warning: cannot access `~a': ~a~%")
  79. path (strerror errno))
  80. result)
  81. '()
  82. %distro-module-directory
  83. stat))
  84. (define (package-modules)
  85. "Return the list of modules that provide packages for the distribution."
  86. (define not-slash
  87. (char-set-complement (char-set #\/)))
  88. (filter-map (lambda (path)
  89. (let ((name (map string->symbol
  90. (string-tokenize (string-drop-right path 4)
  91. not-slash))))
  92. (false-if-exception (resolve-interface name))))
  93. (package-files)))
  94. (define* (find-packages-by-name name #:optional version)
  95. "Return the list of packages with the given NAME. If VERSION is not #f,
  96. then only return packages whose version is equal to VERSION."
  97. (define right-package?
  98. (if version
  99. (lambda (p)
  100. (and (package? p)
  101. (string=? (package-name p) name)
  102. (string=? (package-version p) version)))
  103. (lambda (p)
  104. (and (package? p)
  105. (string=? (package-name p) name)))))
  106. (append-map (lambda (module)
  107. (filter right-package?
  108. (module-map (lambda (sym var)
  109. (variable-ref var))
  110. module)))
  111. (package-modules)))