guix/packages.scm

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