Add supporting tools for the GNU Build System.

* guix/derivations.scm (build-expression->derivation): Add all of INPUTS
  as inputs to the final derivation.

* guix/build/gnu-build-system.scm, guix/build/utils.scm,
  guix/gnu-build-system.scm: New files.

* tests/builders.scm ("gnu-build"): New test.

guix/build/gnu-build-system.scm

+;;; 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 build gnu-build-system)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 ftw)
+  #:export (gnu-build))
+
+;; Commentary:
+;;
+;; Standard build procedure for packages using the GNU Build System or
+;; something compatible ("./configure && make && make install").  This is the
+;; builder-side code.
+;;
+;; Code:
+
+(define (first-subdirectory dir)
+  "Return the path of the first sub-directory of DIR."
+  (file-system-fold (lambda (path stat result)
+                      (string=? path dir))
+                    (lambda (path stat result) result) ; leaf
+                    (lambda (path stat result) result) ; down
+                    (lambda (path stat result) result) ; up
+                    (lambda (path stat result)         ; skip
+                      (or result path))
+                    (lambda (path stat errno result)   ; error
+                      (error "first-subdirectory" (strerror errno)))
+                    #f
+                    dir))
+
+(define (unpack source)
+  (system* "tar" "xvf" source)
+  (chdir (first-subdirectory ".")))
+
+(define (configure outputs flags)
+  (let ((prefix     (assoc-ref outputs "out"))
+        (libdir     (assoc-ref outputs "lib"))
+        (includedir (assoc-ref outputs "include")))
+   (apply system* "./configure"
+          "--enable-fast-install"
+          (string-append "--prefix=" prefix)
+          `(,@(if libdir
+                  (list (string-append "--libdir=" libdir))
+                  '())
+            ,@(if includedir
+                  (list (string-append "--includedir=" includedir))
+                  '())
+            ,@flags))))
+
+(define* (gnu-build source outputs inputs
+                    #:key (configure-flags '()))
+  "Build from SOURCE to OUTPUTS, using INPUTS."
+  (let ((inputs (map cdr inputs)))
+    (set-path-environment-variable "PATH" '("bin") inputs)
+    (set-path-environment-variable "CPATH" '("include") inputs)
+    (set-path-environment-variable "LIBRARY_PATH" '("lib" "lib64") inputs))
+  (pk (getenv "PATH"))
+  (pk 'inputs inputs)
+  (system* "ls" "/nix/store")
+  (unpack source)
+  (configure outputs configure-flags)
+  (system* "make")
+  (system* "make" "check")
+  (system* "make" "install"))

guix/build/utils.scm

+;;; 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 build utils)
+  #:use-module (srfi srfi-1)
+  #:export (directory-exists?
+            set-path-environment-variable))
+
+(define (directory-exists? dir)
+  "Return #t if DIR exists and is a directory."
+  (pk 'dir-exists? dir
+      (let ((s (pk 'stat dir (stat dir #f))))
+     (and s
+          (eq? 'directory (stat:type s))))))
+
+(define (search-path-as-list sub-directories input-dirs)
+  "Return the list of directories among SUB-DIRECTORIES that exist in
+INPUT-DIRS.  Example:
+
+  (search-path-as-list '(\"share/emacs/site-lisp\" \"share/emacs/24.1\")
+                       (list \"/package1\" \"/package2\" \"/package3\"))
+  => (\"/package1/share/emacs/site-lisp\"
+      \"/package3/share/emacs/site-lisp\")
+
+"
+  (append-map (lambda (input)
+                (filter-map (lambda (dir)
+                              (let ((dir (string-append input "/"
+                                                        dir)))
+                                (and (directory-exists? dir)
+                                     dir)))
+                            sub-directories))
+              input-dirs))
+
+(define (list->search-path-as-string lst separator)
+  (string-join lst separator))
+
+(define* (set-path-environment-variable env-var sub-directories input-dirs
+                                        #:key (separator ":"))
+  "Look for each of SUB-DIRECTORIES in INPUT-DIRS.  Set ENV-VAR to a
+SEPARATOR-separated path accordingly.  Example:
+
+  (set-path-environment-variable \"PKG_CONFIG\"
+                                 '(\"lib/pkgconfig\")
+                                 (list package1 package2))
+"
+  (setenv env-var
+          (list->search-path-as-string (search-path-as-list sub-directories
+                                                            input-dirs)
+                                       separator)))

guix/derivations.scm

@@ -482,6 +482,7 @@ (define %build-inputs
                 '(("HOME" . "/homeless"))
                 `((,(%guile-for-build))
                   (,builder)
+                  ,@(map (compose list cdr) inputs)
                   ,@(if mod-drv `((,mod-drv)) '()))
                 #:hash hash #:hash-algo hash-algo
                 #:outputs outputs)))

guix/gnu-build-system.scm

+;;; 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 gnu-build-system)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix derivations)
+  #:use-module (srfi srfi-1)
+  #:export (gnu-build))
+
+;; Commentary:
+;;
+;; Standard build procedure for packages using the GNU Build System or
+;; something compatible ("./configure && make && make install").
+;;
+;; Code:
+
+(define %standard-inputs
+  (map (lambda (name)
+         (cons name (nixpkgs-derivation name)))
+       '("gnutar" "gzip" "bzip2" "xz"
+         "coreutils" "gnused" "gnugrep" "bash"
+         "gcc" "binutils" "gnumake" "glibc")))
+
+(define* (gnu-build store name source inputs
+                    #:key (outputs '("out")) (configure-flags '())
+                    (system (%current-system)))
+  "Return a derivation called NAME that builds from tarball SOURCE, with
+input derivation INPUTS, using the usual procedure of the GNU Build System."
+  (define builder
+    `(begin
+       (use-modules (guix build gnu-build-system))
+       (gnu-build ,(if (derivation-path? source)
+                       (derivation-path->output-path source)
+                       source)
+                  %outputs
+                  %build-inputs
+                  #:configure-flags ',configure-flags)))
+
+  (build-expression->derivation store name system
+                                builder
+                                (alist-cons "source" source
+                                            (append inputs %standard-inputs))
+                                #:outputs outputs
+                                #:modules '((guix build gnu-build-system)
+                                            (guix build utils))))

tests/builders.scm

@@ -19,6 +19,7 @@
 
 (define-module (test-builders)
   #:use-module (guix http)
+  #:use-module (guix gnu-build-system)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix derivations)
@@ -40,6 +41,17 @@ (define %store
     (and (build-derivations %store (list drv-path))
          (file-exists? (derivation-path->output-path drv-path)))))
 
+(test-assert "gnu-build"
+  (let* ((url      "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
+         (hash     (nix-base32-string->bytevector
+                    "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
+         (tarball  (http-fetch %store url 'sha256 hash))
+         (build    (gnu-build %store "hello-2.8" tarball
+                              `(("gawk" . ,(nixpkgs-derivation "gawk"))))))
+    (and (build-derivations %store (list (pk 'hello-drv build)))
+         (file-exists? (string-append (derivation-path->output-path build)
+                                      "/bin/hello")))))
+
 (test-end "builders")