[PATCH] Add 'waf-build-system'.

[Ricardo Wurmus <rekado@elephly.net>]

[-- Attachment #1: Type: text/plain, Size: 650 bytes --]

Hi Guix,

attached is a patch to add the waf build system.  Although waf is called
a meta build system, most applications that I've encountered so far (all
related to audio) have the standard build phases as the GNU build
system.

The waf build system is embarrassingly similar to the Python build
system.  Essentially, the phases are run by executing

    python waf $PHASE

instead of

    python setup.py $PHASE

Unlike the Python build system, however, there is a configure phase, and
not everything important happens during the install phase.

I'm using the waf-build-system for packaging LV2, Ardour, JACK2, and
related libraries.

~~ Ricardo


[-- Attachment #2: 0001-Add-waf-build-system.patch --]
[-- Type: text/x-patch, Size: 9869 bytes --]

From adc52a74fb12943fd77c97bf75a2092e839f9024 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Wed, 28 Jan 2015 22:39:03 +0100
Subject: [PATCH] Add 'waf-build-system'.

* guix/build-system/waf.scm, guix/build/waf-build-system.scm: New files.
* Makefile.am (MODULES): Add them.
---
 Makefile.am                     |   2 +
 guix/build-system/waf.scm       | 128 ++++++++++++++++++++++++++++++++++++++++
 guix/build/waf-build-system.scm |  86 +++++++++++++++++++++++++++
 3 files changed, 216 insertions(+)
 create mode 100644 guix/build-system/waf.scm
 create mode 100644 guix/build/waf-build-system.scm

diff --git a/Makefile.am b/Makefile.am
index 67367d6..6a4a09b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -53,6 +53,7 @@ MODULES =					\
   guix/build-system/gnu.scm			\
   guix/build-system/perl.scm			\
   guix/build-system/python.scm			\
+  guix/build-system/waf.scm			\
   guix/build-system/ruby.scm			\
   guix/build-system/trivial.scm			\
   guix/ftp-client.scm				\
@@ -71,6 +72,7 @@ MODULES =					\
   guix/build/perl-build-system.scm		\
   guix/build/python-build-system.scm		\
   guix/build/ruby-build-system.scm		\
+  guix/build/waf-build-system.scm		\
   guix/build/store-copy.scm			\
   guix/build/utils.scm				\
   guix/build/union.scm				\
diff --git a/guix/build-system/waf.scm b/guix/build-system/waf.scm
new file mode 100644
index 0000000..494cb95
--- /dev/null
+++ b/guix/build-system/waf.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU 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.
+;;;
+;;; GNU 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system waf)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module ((guix build-system python)
+                #:select (default-python default-python2))
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
+  #:export (waf-build
+            waf-build-system))
+
+;; Commentary:
+;;
+;; Standard build procedure for applications using 'waf'.  This is very
+;; similar to the 'python-build-system' and is implemented as an extension of
+;; 'gnu-build-system'.
+;;
+;; Code:
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                (python (default-python))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:source #:target #:python #:inputs #:native-inputs))
+
+  (and (not target)                               ;XXX: no cross-compilation
+       (bag
+         (name name)
+         (system system)
+         (host-inputs `(,@(if source
+                              `(("source" ,source))
+                              '())
+                        ,@inputs
+
+                        ;; Keep the standard inputs of 'gnu-build-system'.
+                        ,@(standard-packages)))
+         (build-inputs `(("python" ,python)
+                         ,@native-inputs))
+         (outputs outputs)
+         (build waf-build) ; only change compared to 'lower' in python.scm
+         (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (waf-build store name inputs
+                       #:key
+                       (tests? #t)
+                       (test-target "check")
+                       (configure-flags ''())
+                       (phases '(@ (guix build waf-build-system)
+                                   %standard-phases))
+                       (outputs '("out"))
+                       (search-paths '())
+                       (system (%current-system))
+                       (guile #f)
+                       (imported-modules '((guix build waf-build-system)
+                                           (guix build gnu-build-system)
+                                           (guix build utils)))
+                       (modules '((guix build waf-build-system)
+                                  (guix build utils))))
+  "Build SOURCE with INPUTS.  This assumes that SOURCE provides a 'waf' file
+as its build system."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (waf-build #:name ,name
+                  #:source ,(match (assoc-ref inputs "source")
+                              (((? derivation? source))
+                               (derivation->output-path source))
+                              ((source)
+                               source)
+                              (source
+                               source))
+                  #:configure-flags ,configure-flags
+                  #:system ,system
+                  #:test-target ,test-target
+                  #:tests? ,tests?
+                  #:phases ,phases
+                  #:outputs %outputs
+                  #:search-paths ',(map search-path-specification->sexp
+                                        search-paths)
+                  #:inputs %build-inputs)))
+
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system #:graft? #f))
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(gnu packages commencement)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system #:graft? #f)))))
+
+  (build-expression->derivation store name builder
+                                #:inputs inputs
+                                #:system system
+                                #:modules imported-modules
+                                #:outputs outputs
+                                #:guile-for-build guile-for-build))
+
+(define waf-build-system
+  (build-system
+    (name 'waf)
+    (description "The standard waf build system")
+    (lower lower)))
+
+;;; waf.scm ends here
diff --git a/guix/build/waf-build-system.scm b/guix/build/waf-build-system.scm
new file mode 100644
index 0000000..e64b51a
--- /dev/null
+++ b/guix/build/waf-build-system.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU 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.
+;;;
+;;; GNU 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build waf-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (%standard-phases
+            waf-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the standard waf build procedure.
+;;
+;; Code:
+
+
+(define (call-waf command params)
+  (if (file-exists? "waf")
+      (begin
+         (format #t "running \"python waf\" with command ~s and parameters ~s~%"
+                command params)
+         (zero? (apply system* "python" "waf" command params)))
+      (error "no waf found")))
+
+(define* (configure #:key target native-inputs inputs outputs
+                    (configure-flags '())
+                    #:allow-other-keys)
+  "Build a given waf application."
+  (let* ((prefix (assoc-ref outputs "out"))
+         (flags  `(,(string-append "--prefix=" prefix)
+                   ,@configure-flags)))
+    (call-waf "configure" flags)))
+
+(define* (build #:rest empty)
+  "Build a given waf application."
+  (call-waf "build" '()))
+
+(define* (check #:key tests? test-target #:allow-other-keys)
+  "Run the test suite of a given waf application."
+  (if tests?
+    (call-waf test-target '())
+    #t))
+
+(define* (install #:key outputs inputs (configure-flags '())
+                  #:allow-other-keys)
+  "Install a given waf application."
+  (let* ((out (assoc-ref outputs "out"))
+         (params (append (list (string-append "--prefix=" out))
+                         configure-flags)))
+        (call-waf "install" params)))
+
+(define %standard-phases
+  (alist-replace
+   'configure configure
+   (alist-replace
+    'build build
+    (alist-replace
+     'check check
+     (alist-replace 'install install
+                    gnu:%standard-phases)))))
+
+(define* (waf-build #:key inputs (phases %standard-phases)
+                       #:allow-other-keys #:rest args)
+  "Build the given waf application, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
+
+;;; waf-build-system.scm ends here
-- 
2.1.0