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.

192 lines
7.0 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 (guix packages)
  19. #:use-module (guix utils)
  20. #:use-module (guix store)
  21. #:use-module (guix build-system)
  22. #:use-module (ice-9 match)
  23. #:use-module (srfi srfi-1)
  24. #:use-module (srfi srfi-9)
  25. #:export (location
  26. location?
  27. location-file
  28. location-line
  29. location-column
  30. source
  31. package-source?
  32. package-source-uri
  33. package-source-method
  34. package-source-sha256
  35. package-source-file-name
  36. base32
  37. package
  38. package?
  39. package-name
  40. package-version
  41. package-source
  42. package-build-system
  43. package-arguments
  44. package-inputs
  45. package-native-inputs
  46. package-propagated-inputs
  47. package-outputs
  48. package-search-paths
  49. package-description
  50. package-long-description
  51. package-license
  52. package-platforms
  53. package-maintainers
  54. package-properties
  55. package-location
  56. package-source-derivation
  57. package-derivation
  58. package-cross-derivation))
  59. ;;; Commentary:
  60. ;;;
  61. ;;; This module provides a high-level mechanism to define packages in a
  62. ;;; Guix-based distribution.
  63. ;;;
  64. ;;; Code:
  65. ;; A source location.
  66. (define-record-type <location>
  67. (make-location file line column)
  68. location?
  69. (file location-file) ; file name
  70. (line location-line) ; 1-indexed line
  71. (column location-column)) ; 0-indexed column
  72. (define location
  73. (memoize
  74. (lambda (file line column)
  75. "Return the <location> object for the given FILE, LINE, and COLUMN."
  76. (and line column file
  77. (make-location file line column)))))
  78. (define (source-properties->location loc)
  79. "Return a location object based on the info in LOC, an alist as returned
  80. by Guile's `source-properties', `frame-source', `current-source-location',
  81. etc."
  82. (let ((file (assq-ref loc 'filename))
  83. (line (assq-ref loc 'line))
  84. (col (assq-ref loc 'column)))
  85. (location file (and line (+ line 1)) col)))
  86. ;; The source of a package, such as a tarball URL and fetcher.
  87. (define-record-type* <package-source>
  88. source make-package-source
  89. package-source?
  90. (uri package-source-uri) ; string
  91. (method package-source-method) ; symbol
  92. (sha256 package-source-sha256) ; bytevector
  93. (file-name package-source-file-name ; optional file name
  94. (default #f)))
  95. (define-syntax base32
  96. (lambda (s)
  97. "Return the bytevector corresponding to the given Nix-base32
  98. representation."
  99. (syntax-case s ()
  100. ((_ str)
  101. (string? (syntax->datum #'str))
  102. (with-syntax ((bv (nix-base32-string->bytevector
  103. (syntax->datum #'str))))
  104. #''bv)))))
  105. ;; A package.
  106. (define-record-type* <package>
  107. package make-package
  108. package?
  109. (name package-name) ; string
  110. (version package-version) ; string
  111. (source package-source) ; <package-source> instance
  112. (build-system package-build-system) ; build system
  113. (arguments package-arguments ; arguments for the build method
  114. (default '()))
  115. (inputs package-inputs ; input packages or derivations
  116. (default '()))
  117. (propagated-inputs package-propagated-inputs ; same, but propagated
  118. (default '()))
  119. (native-inputs package-native-inputs ; native input packages/derivations
  120. (default '()))
  121. (outputs package-outputs ; list of strings
  122. (default '("out")))
  123. (search-paths package-search-paths ; list of (ENV-VAR (DIRS ...))
  124. (default '())) ; tuples; see
  125. ; `set-path-environment-variable'
  126. ; (aka. "setup-hook")
  127. (description package-description) ; one-line description
  128. (long-description package-long-description) ; one or two paragraphs
  129. (license package-license (default '()))
  130. (home-page package-home-page)
  131. (platforms package-platforms (default '()))
  132. (maintainers package-maintainers (default '()))
  133. (properties package-properties (default '())) ; alist for anything else
  134. (location package-location
  135. (default (and=> (current-source-location)
  136. source-properties->location))))
  137. (define (package-source-derivation store source)
  138. "Return the derivation path for SOURCE, a package source."
  139. (match source
  140. (($ <package-source> uri method sha256 name)
  141. (method store uri 'sha256 sha256 name))))
  142. (define* (package-derivation store package
  143. #:optional (system (%current-system)))
  144. "Return the derivation of PACKAGE for SYSTEM."
  145. (match package
  146. (($ <package> name version source (= build-system-builder builder)
  147. args inputs native-inputs propagated-inputs outputs)
  148. ;; TODO: For `search-paths', add a builder prologue that calls
  149. ;; `set-path-environment-variable'.
  150. (let ((inputs (map (match-lambda
  151. (((? string? name) (and package ($ <package>)))
  152. (list name (package-derivation store package)))
  153. (((? string? name) (and package ($ <package>))
  154. (? string? sub-drv))
  155. (list name (package-derivation store package)
  156. sub-drv))
  157. (((? string? name)
  158. (and (? string?) (? derivation-path?) drv))
  159. (list name drv)))
  160. (concatenate (list native-inputs inputs
  161. propagated-inputs)))))
  162. (apply builder
  163. store (string-append name "-" version)
  164. (package-source-derivation store source)
  165. inputs
  166. #:outputs outputs #:system system
  167. (if (procedure? args)
  168. (args system)
  169. args))))))
  170. (define* (package-cross-derivation store package)
  171. ;; TODO
  172. #f)