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.
This commit is contained in:
Ludovic Courtès 2012-06-16 16:56:47 +02:00
parent 3ab892fffe
commit 5dcfdcaa79
2 changed files with 66 additions and 38 deletions

View File

@ -19,7 +19,10 @@
(define-module (guix build gnu-build-system) (define-module (guix build gnu-build-system)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:export (gnu-build)) #:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (%standard-phases
gnu-build))
;; Commentary: ;; Commentary:
;; ;;
@ -43,15 +46,21 @@
#f #f
dir)) dir))
(define (unpack source) (define* (set-paths #:key inputs #:allow-other-keys)
(system* "tar" "xvf" source) (let ((inputs (map cdr inputs)))
(chdir (first-subdirectory "."))) (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")) (let ((prefix (assoc-ref outputs "out"))
(libdir (assoc-ref outputs "lib")) (libdir (assoc-ref outputs "lib"))
(includedir (assoc-ref outputs "include"))) (includedir (assoc-ref outputs "include")))
(apply system* "./configure" (zero? (apply system* "./configure"
"--enable-fast-install" "--enable-fast-install"
(string-append "--prefix=" prefix) (string-append "--prefix=" prefix)
`(,@(if libdir `(,@(if libdir
@ -60,20 +69,36 @@
,@(if includedir ,@(if includedir
(list (string-append "--includedir=" includedir)) (list (string-append "--includedir=" includedir))
'()) '())
,@flags)))) ,@configure-flags)))))
(define* (gnu-build source outputs inputs (define* (build #:key (make-flags '()) #:allow-other-keys)
#:key (configure-flags '())) (zero? (apply system* "make" make-flags)))
"Build from SOURCE to OUTPUTS, using INPUTS."
(let ((inputs (map cdr inputs))) (define* (check #:key (make-flags '()) #:allow-other-keys)
(set-path-environment-variable "PATH" '("bin") inputs) (zero? (apply system* "make" "check" make-flags)))
(set-path-environment-variable "CPATH" '("include") inputs)
(set-path-environment-variable "LIBRARY_PATH" '("lib" "lib64") inputs)) (define* (install #:key (make-flags '()) #:allow-other-keys)
(pk (getenv "PATH")) (zero? (apply system* "make" "install" make-flags)))
(pk 'inputs inputs)
(system* "ls" "/nix/store") (define %standard-phases
(unpack source) ;; Standard build phases, as a list of symbol/procedure pairs.
(configure outputs configure-flags) (let-syntax ((phases (syntax-rules ()
(system* "make") ((_ p ...) `((p . ,p) ...)))))
(system* "make" "check") (phases set-paths unpack configure build check install)))
(system* "make" "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))

View File

@ -39,18 +39,21 @@
(define* (gnu-build store name source inputs (define* (gnu-build store name source inputs
#:key (outputs '("out")) (configure-flags '()) #:key (outputs '("out")) (configure-flags '())
(make-flags '()) (phases '%standard-phases)
(system (%current-system))) (system (%current-system)))
"Return a derivation called NAME that builds from tarball SOURCE, with "Return a derivation called NAME that builds from tarball SOURCE, with
input derivation INPUTS, using the usual procedure of the GNU Build System." input derivation INPUTS, using the usual procedure of the GNU Build System."
(define builder (define builder
`(begin `(begin
(use-modules (guix build gnu-build-system)) (use-modules (guix build gnu-build-system))
(gnu-build ,(if (derivation-path? source) (gnu-build #:source ,(if (derivation-path? source)
(derivation-path->output-path source) (derivation-path->output-path source)
source) source)
%outputs #:outputs %outputs
%build-inputs #:inputs %build-inputs
#:configure-flags ',configure-flags))) #:phases ,phases
#:configure-flags ',configure-flags
#:make-flags ',make-flags)))
(build-expression->derivation store name system (build-expression->derivation store name system
builder builder