From 5dcfdcaa79800530c4b7ea520b5eb984a5e6b7ca Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 16 Jun 2012 16:56:47 +0200
Subject: gnu-build-system: Structure as a customizable sequence of phases.

* guix/build/gnu-build-system.scm (set-paths, build, check, install):
  New procedures.
  (unpack): Make `source' a keyword arg; add `#:allow-other-keys'.
  (configure): Likewise.
  (%standard-phases): New variable.
  (gnu-build): Make `source', `outputs', and `inputs' keyword arguments;
  add `phases' keyword argument; #:allow-other-keys; add rest arguments
  `args'.  Invoke each of PHASES in order within `every'.

* guix/gnu-build-system.scm (gnu-build): Add `make-flags' and `phases'
  keyword arguments.  Update builder's `gnu-build' call to match the new
  convention.
---
 guix/build/gnu-build-system.scm | 85 ++++++++++++++++++++++++++---------------
 1 file changed, 55 insertions(+), 30 deletions(-)

(limited to 'guix/build')

diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 11d3faba92..a6f1c73e0a 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -19,7 +19,10 @@
 (define-module (guix build gnu-build-system)
   #:use-module (guix build utils)
   #:use-module (ice-9 ftw)
-  #:export (gnu-build))
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (%standard-phases
+            gnu-build))
 
 ;; Commentary:
 ;;
@@ -43,37 +46,59 @@
                     #f
                     dir))
 
-(define (unpack source)
-  (system* "tar" "xvf" source)
-  (chdir (first-subdirectory ".")))
+(define* (set-paths #:key inputs #:allow-other-keys)
+  (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)))
 
-(define (configure outputs flags)
+(define* (unpack #:key source #:allow-other-keys)
+  (and (zero? (system* "tar" "xvf" source))
+       (chdir (first-subdirectory "."))))
+
+(define* (configure #:key outputs (configure-flags '()) #:allow-other-keys)
   (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))))
+    (zero? (apply system* "./configure"
+                  "--enable-fast-install"
+                  (string-append "--prefix=" prefix)
+                  `(,@(if libdir
+                          (list (string-append "--libdir=" libdir))
+                          '())
+                    ,@(if includedir
+                          (list (string-append "--includedir=" includedir))
+                          '())
+                    ,@configure-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"))
+(define* (build #:key (make-flags '()) #:allow-other-keys)
+  (zero? (apply system* "make" make-flags)))
+
+(define* (check #:key (make-flags '()) #:allow-other-keys)
+  (zero? (apply system* "make" "check" make-flags)))
+
+(define* (install #:key (make-flags '()) #:allow-other-keys)
+  (zero? (apply system* "make" "install" make-flags)))
+
+(define %standard-phases
+  ;; Standard build phases, as a list of symbol/procedure pairs.
+  (let-syntax ((phases (syntax-rules ()
+                         ((_ p ...) `((p . ,p) ...)))))
+    (phases set-paths unpack configure build check install)))
+
+
+(define* (gnu-build #:key (source #f) (outputs #f) (inputs #f)
+                    (phases %standard-phases)
+                    #:allow-other-keys
+                    #:rest args)
+  "Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES
+in order.  Return #t if all the PHASES succeeded, #f otherwise."
+  (setvbuf (current-output-port) _IOLBF)
+
+  ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
+  ;; PHASES can pick the keyword arguments it's interested in.
+  (every (match-lambda
+          ((name . proc)
+           (format #t "starting phase `~a'~%" name)
+           (apply proc args)))
+         phases))
-- 
cgit v1.2.3