Add a declarative packaging layer.

* Makefile.am (MODULES): Add `guix/packages.scm' and `distro/base.scm'.
  (TESTS): Add `tests/packages.scm'.
  (EXTRA_DIST): New variable.

* guix/packages.scm, distro/base.scm, tests/packages.scm: New files.

* guix/http.scm (http-fetch): Make `name' an optional argument, to match
  the expectations of `package-source-derivation'.

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:

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+")))

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

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)

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: