diff options
| -rw-r--r-- | Makefile.am | 8 | ||||
| -rw-r--r-- | distro/base.scm | 49 | ||||
| -rw-r--r-- | guix/http.scm | 3 | ||||
| -rw-r--r-- | guix/packages.scm | 127 | ||||
| -rw-r--r-- | tests/packages.scm | 51 |
5 files changed, 235 insertions, 3 deletions
diff --git a/Makefile.am b/Makefile.am index b2b6d943a5..8b5713b1d9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -26,7 +26,9 @@ MODULES = \ guix/build/gnu-build-system.scm \ guix/build/http.scm \ guix/build/utils.scm \ - guix.scm + guix/packages.scm \ + guix.scm \ + distro/base.scm GOBJECTS = $(MODULES:%.scm=%.go) @@ -36,13 +38,15 @@ nobase_nodist_guilemodule_DATA = $(GOBJECTS) TESTS = \ tests/builders.scm \ tests/derivations.scm \ - tests/utils.scm + tests/utils.scm \ + tests/packages.scm TESTS_ENVIRONMENT = \ NIXPKGS="$(NIXPKGS)" \ GUILE_LOAD_COMPILED_PATH="$(top_builddir):$$GUILE_LOAD_COMPILED_PATH" \ $(GUILE) -L "$(top_srcdir)" +EXTRA_DIST = $(TESTS) CLEANFILES = $(GOBJECTS) *.log .scm.go: diff --git a/distro/base.scm b/distro/base.scm new file mode 100644 index 0000000000..d830d6efef --- /dev/null +++ b/distro/base.scm @@ -0,0 +1,49 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of Guix. +;;; +;;; Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (distro base) + #:use-module (guix packages) + #:use-module (guix http) + #:use-module (guix build-system gnu) + #:use-module (guix utils)) + +;;; Commentary: +;;; +;;; A Guix-based distribution. +;;; +;;; Code: + +(define-public hello + (package + (name "hello") + (version "2.8") + (source (source + (method http-fetch) + (uri "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") + (sha256 + (nix-base32-string->bytevector ; TODO: make conversion implicit + "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")))) + (build-system gnu-build-system) + (arguments '(#:configure-flags + `("--disable-dependency-tracking" + ,(string-append "--with-gawk=" ; for illustration purposes + (assoc-ref %build-inputs "gawk"))))) + (inputs `(("gawk" ,(nixpkgs-derivation "gawk")))) + (description "GNU Hello") + (long-description "Yeah...") + (license "GPLv3+"))) diff --git a/guix/http.scm b/guix/http.scm index 21234b388f..97ed3983f1 100644 --- a/guix/http.scm +++ b/guix/http.scm @@ -28,7 +28,8 @@ ;;; Code: (define* (http-fetch store url hash-algo hash - #:key name (system (%current-system))) + #:optional name + #:key (system (%current-system))) "Return the path of a fixed-output derivation in STORE that fetches URL, which is expected to have hash HASH of type HASH-ALGO (a symbol). By default, the file name is the base name of URL; optionally, NAME can specify diff --git a/guix/packages.scm b/guix/packages.scm new file mode 100644 index 0000000000..c7633accef --- /dev/null +++ b/guix/packages.scm @@ -0,0 +1,127 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of Guix. +;;; +;;; Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix packages) + #:use-module (guix utils) + #:use-module (guix store) + #:use-module (guix build-system) + #:use-module (ice-9 match) + #:export (source + package-source? + package-source-uri + package-source-method + package-source-sha256 + package-source-file-name + + package + package? + package-name + package-version + package-source + package-build-system + package-arguments + package-inputs + package-native-inputs + package-outputs + package-search-paths + package-description + package-long-description + package-license + package-platforms + package-maintainers + + package-source-derivation + package-derivation + package-cross-derivation)) + +;;; Commentary: +;;; +;;; This module provides a high-level mechanism to define packages in a +;;; Guix-based distribution. +;;; +;;; Code: + +(define-record-type* <package-source> + source make-package-source + package-source? + (uri package-source-uri) ; string + (method package-source-method) ; symbol + (sha256 package-source-sha256) ; bytevector + (file-name package-source-file-name ; optional file name + (default #f))) + +(define-record-type* <package> + package make-package + package? + (name package-name) ; string + (version package-version) ; string + (source package-source) ; <package-source> instance + (build-system package-build-system) ; build system + (arguments package-arguments) ; arguments for the build method + (inputs package-inputs ; input packages or derivations + (default '())) + (native-inputs package-native-inputs ; native input packages/derivations + (default '())) + (outputs package-outputs ; list of strings + (default '("out"))) + (search-paths package-search-paths ; list of (ENV-VAR (DIRS ...)) + (default '())) ; tuples; see + ; `set-path-environment-variable' + ; (aka. "setup-hook") + + (description package-description) ; one-line description + (long-description package-long-description) ; one or two paragraphs + (license package-license (default '())) + (platforms package-platforms (default '())) + (maintainers package-maintainers (default '()))) + +(define (package-source-derivation store source) + "Return the derivation path for SOURCE, a package source." + (match source + (($ <package-source> uri method sha256 name) + (method store uri 'sha256 sha256 name)))) + +(define* (package-derivation store package + #:optional (system (%current-system))) + "Return the derivation of PACKAGE for SYSTEM." + (match package + (($ <package> name version source (= build-system-builder builder) + args inputs native-inputs outputs) + ;; TODO: For `search-paths', add a builder prologue that calls + ;; `set-path-environment-variable'. + (let ((inputs (map (match-lambda + (((? string? name) (and package ($ <package>))) + (list name (package-derivation store package))) + (((? string? name) (and package ($ <package>)) + (? string? sub-drv)) + (list name (package-derivation store package) + sub-drv)) + (((? string? name) + (and (? string?) (? derivation-path?) drv)) + (list name drv))) + (append native-inputs inputs)))) + (apply builder + store (string-append name "-" version) + (package-source-derivation store source) + inputs + #:outputs outputs #:system system + args))))) + +(define* (package-cross-derivation store package) + ;; TODO + #f) diff --git a/tests/packages.scm b/tests/packages.scm new file mode 100644 index 0000000000..76f63f3662 --- /dev/null +++ b/tests/packages.scm @@ -0,0 +1,51 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of Guix. +;;; +;;; Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. + + +(define-module (test-packages) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (distro base) + #:use-module (srfi srfi-64)) + +;; Test the high-level packaging layer. + +(define %store + (false-if-exception (open-connection))) + +(test-begin "packages") + +(test-skip (if (not %store) 1 0)) + +(test-assert "GNU Hello" + (and (package? hello) + (let* ((drv (package-derivation %store hello)) + (out (derivation-path->output-path drv))) + (and (build-derivations %store (list drv)) + (file-exists? (string-append out "/bin/hello")))))) + +(test-end "packages") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'test-assert 'scheme-indent-function 1) +;;; End: |