From dd1a5a152c679ba2d386dc66127a0de924182e26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 Dec 2013 16:07:36 +0100 Subject: [PATCH] derivations: Use more keyword parameters for 'build-expression->derivation'. * guix/derivations.scm (build-expression->derivation): Turn 'system' and 'inputs' into keyword parameters. Adjust callers accordingly. * gnu/system/linux.scm, gnu/system/vm.scm, guix/build-system/cmake.scm, guix/build-system/gnu.scm, guix/build-system/perl.scm, guix/build-system/python.scm, guix/build-system/trivial.scm, guix/download.scm, guix/packages.scm, guix/profiles.scm, guix/scripts/pull.scm, tests/derivations.scm, tests/guix-build.sh, tests/monads.scm, tests/store.scm, tests/union.scm: Adjust users of 'build-expression->derivation' and 'derivation-expression' accordingly. * doc/guix.texi (Derivations): Adjust 'build-expression->derivation' documentation accordingly. (The Store Monad): Likewise for 'derivation-expression'. --- doc/guix.texi | 15 ++++--- gnu/system/linux.scm | 3 +- gnu/system/vm.scm | 9 +++-- guix/build-system/cmake.scm | 5 ++- guix/build-system/gnu.scm | 10 +++-- guix/build-system/perl.scm | 5 ++- guix/build-system/python.scm | 5 ++- guix/build-system/trivial.scm | 13 +++--- guix/derivations.scm | 17 +++++--- guix/download.scm | 10 ++--- guix/packages.scm | 9 +++-- guix/profiles.scm | 5 +-- guix/scripts/pull.scm | 4 +- tests/derivations.scm | 76 +++++++++++------------------------ tests/guix-build.sh | 3 +- tests/monads.scm | 5 ++- tests/store.scm | 6 +-- tests/union.scm | 4 +- 18 files changed, 98 insertions(+), 106 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index eadca0fc2d..64ddb8539e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1246,7 +1246,12 @@ As can be guessed, this primitive is cumbersome to use directly. An improved variant is @code{build-expression->derivation}, which allows the caller to directly pass a Guile expression as the build script: -@deffn {Scheme Procedure} build-expression->derivation @var{store} @var{name} @var{system} @var{exp} @var{inputs} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:env-vars '()] [#:modules '()] [#:references-graphs #f] [#:guile-for-build #f] +@deffn {Scheme Procedure} build-expression->derivation @var{store} @ + @var{name} @var{exp} @ + [#:system (%current-system)] [#:inputs '()] @ + [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @ + [#:env-vars '()] [#:modules '()] @ + [#:references-graphs #f] [#:guile-for-build #f] Return a derivation that executes Scheme expression @var{exp} as a builder for derivation @var{name}. @var{inputs} must be a list of @code{(name drv-path sub-drv)} tuples; when @var{sub-drv} is omitted, @@ -1281,8 +1286,7 @@ containing one file: (call-with-output-file (string-append out "/test") (lambda (p) (display '(hello guix) p)))))) - (build-expression->derivation store "goo" (%current-system) - builder '())) + (build-expression->derivation store "goo" builder)) @result{} # @dots{}> @end lisp @@ -1425,8 +1429,9 @@ directory of @var{package}. When @var{file} is omitted, return the name of the @var{output} directory of @var{package}. @end deffn -@deffn {Monadic Procedure} derivation-expression @var{name} @var{system} @ - @var{exp} @var{inputs} [#:outputs '("out")] [#:hash #f] @ +@deffn {Monadic Procedure} derivation-expression @var{name} @var{exp} @ + [#:system (%current-system)] [#:inputs '()] @ + [#:outputs '("out")] [#:hash #f] @ [#:hash-algo #f] [#:env-vars '()] [#:modules '()] @ [#:references-graphs #f] [#:guile-for-build #f] Monadic version of @code{build-expression->derivation} diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index eb3e133044..65868ce9bf 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -108,7 +108,8 @@ %build-inputs) #t))) - (derivation-expression "pam.d" (%current-system) builder (zip names files)))) + (derivation-expression "pam.d" builder + #:inputs (zip names files)))) (define %pam-other-services ;; The "other" PAM configuration, which denies everything (see diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 2413a97150..a9f157d915 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -196,7 +196,9 @@ made available under the /xchg CIFS share." ("coreutils" ,coreutils) ("builder" ,user-builder) ,@inputs)))) - (derivation-expression name system builder inputs + (derivation-expression name builder + #:system system + #:inputs inputs #:env-vars env-vars #:modules (delete-duplicates `((guix build utils) @@ -450,8 +452,9 @@ input tuples." (x (return x))) inputs)))) - (derivation-expression name system builder - inputs + (derivation-expression name builder + #:system system + #:inputs inputs #:modules '((guix build union)) #:guile-for-build guile))) diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 1a5f4b6ad1..8c9a32c8ab 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -104,8 +104,9 @@ provides a 'CMakeLists.txt' file as its build system." (package-derivation store guile system))))) (let ((cmake (package-derivation store cmake system))) - (build-expression->derivation store name system - builder + (build-expression->derivation store name builder + #:system system + #:inputs `(,@(if source `(("source" ,source)) '()) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 7725b8b67a..333ae9273e 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -323,8 +323,9 @@ which could lead to gratuitous input divergence." (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) - (build-expression->derivation store name system - builder + (build-expression->derivation store name builder + #:system system + #:inputs `(,@(if source `(("source" ,source)) '()) @@ -493,8 +494,9 @@ platform." (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) - (build-expression->derivation store name system - builder + (build-expression->derivation store name builder + #:system system + #:inputs `(,@(if source `(("source" ,source)) '()) diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index 5dc50d97f3..4e5aea3a2f 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -93,8 +93,9 @@ provides a `Makefile.PL' file as its build system." (package-derivation store guile system))))) (let ((perl (package-derivation store perl system))) - (build-expression->derivation store name system - builder + (build-expression->derivation store name builder + #:system system + #:inputs `(,@(if source `(("source" ,source)) '()) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index a97135fe0c..7e26864653 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -146,8 +146,8 @@ provides a 'setup.py' file as its build system." (package-derivation store guile system))))) (let ((python (package-derivation store python system))) - (build-expression->derivation store name system - builder + (build-expression->derivation store name builder + #:inputs `(,@(if source `(("source" ,source)) '()) @@ -158,6 +158,7 @@ provides a 'setup.py' file as its build system." ;; 'gnu-build-system'. ,@(standard-inputs system)) + #:system system #:modules imported-modules #:outputs outputs #:guile-for-build guile-for-build))) diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm index f91997d1e9..5576d596da 100644 --- a/guix/build-system/trivial.scm +++ b/guix/build-system/trivial.scm @@ -42,10 +42,11 @@ search-paths) "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is ignored." - (build-expression->derivation store name system builder - (if source - `(("source" ,source) ,@inputs) - inputs) + (build-expression->derivation store name builder + #:inputs (if source + `(("source" ,source) ,@inputs) + inputs) + #:system system #:outputs outputs #:modules modules #:guile-for-build @@ -56,7 +57,9 @@ ignored." outputs guile system builder (modules '()) search-paths native-search-paths) "Like `trivial-build', but in a cross-compilation context." - (build-expression->derivation store name system builder + (build-expression->derivation store name builder + #:system system + #:inputs (let ((inputs (append native-inputs inputs))) (if source `(("source" ,source) ,@inputs) diff --git a/guix/derivations.scm b/guix/derivations.scm index 63c1ba4f2b..3d9f0affbf 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -824,8 +824,9 @@ system, imported, and appears under FINAL-PATH in the resulting store path." (mkdir ,tail)))))) `((symlink ,store-path ,final-path))))) files)))) - (build-expression->derivation store name system - builder files + (build-expression->derivation store name builder + #:system system + #:inputs files #:guile-for-build guile))) (define* (imported-modules store modules @@ -889,12 +890,16 @@ they can refer to each other." #:opts %auto-compilation-options))))) files))) - (build-expression->derivation store name system builder - `(("modules" ,module-drv)) + (build-expression->derivation store name builder + #:inputs `(("modules" ,module-drv)) + #:system system #:guile-for-build guile))) -(define* (build-expression->derivation store name system exp inputs - #:key (outputs '("out")) +(define* (build-expression->derivation store name exp + #:key + (system (%current-system)) + (inputs '()) + (outputs '("out")) hash hash-algo (env-vars '()) (modules '()) diff --git a/guix/download.scm b/guix/download.scm index 837ff0e683..8a3e9fd06a 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -228,11 +228,11 @@ must be a list of symbol/URL-list pairs." ;; set it here. `(("GUILE_LOAD_PATH" . ,dir))) '()))) - (build-expression->derivation store (or name file-name) system - builder - (if gnutls-drv - `(("gnutls" ,gnutls-drv)) - '()) + (build-expression->derivation store (or name file-name) builder + #:system system + #:inputs (if gnutls-drv + `(("gnutls" ,gnutls-drv)) + '()) #:hash-algo hash-algo #:hash hash #:modules '((guix build download) diff --git a/guix/packages.scm b/guix/packages.scm index c1247b71ac..daf431f5e4 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -386,10 +386,11 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." system))))) (or inputs (%standard-patch-inputs))))) - (build-expression->derivation store name system builder - `(("source" ,source) - ,@inputs - ,@patch-inputs) + (build-expression->derivation store name builder + #:inputs `(("source" ,source) + ,@inputs + ,@patch-inputs) + #:system system #:modules imported-modules #:guile-for-build guile-for-build))) diff --git a/guix/profiles.scm b/guix/profiles.scm index 1f62099e45..9b5c5f515c 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -246,9 +246,8 @@ the given MANIFEST." (lambda (p) (pretty-print ',(manifest->sexp manifest) p)))))) - (build-expression->derivation store "profile" - (%current-system) - builder + (build-expression->derivation store "profile" builder + #:inputs (append-map (match-lambda (($ name version output path deps (inputs ..1)) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index b910276204..5ff2ce0cc1 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -141,8 +141,8 @@ files." (delete-file (string-append out "/guix/config.scm")) (delete-file (string-append out "/guix/config.go"))))) - (build-expression->derivation store "guix-latest" (%current-system) - builder + (build-expression->derivation store "guix-latest" builder + #:inputs `(("tar" ,(package-derivation store tar)) ("gzip" ,(package-derivation store gzip)) ("gcrypt" ,(package-derivation store diff --git a/tests/derivations.scm b/tests/derivations.scm index a4e073bf07..f7cedde505 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -395,8 +395,7 @@ (test-skip (if (%guile-for-build) 0 8)) (test-assert "build-expression->derivation and derivation-prerequisites" - (let ((drv (build-expression->derivation %store "fail" (%current-system) - #f '()))) + (let ((drv (build-expression->derivation %store "fail" #f))) (any (match-lambda (($ path) (string=? path (derivation-file-name (%guile-for-build))))) @@ -408,8 +407,7 @@ (call-with-output-file (string-append %output "/test") (lambda (p) (display '(hello guix) p))))) - (drv (build-expression->derivation %store "goo" (%current-system) - builder '())) + (drv (build-expression->derivation %store "goo" builder)) (succeeded? (build-derivations %store (list drv)))) (and succeeded? (let ((p (derivation->output-path drv))) @@ -421,9 +419,7 @@ (set-build-options s #:max-silent-time 1) s)) (builder '(begin (sleep 100) (mkdir %output) #t)) - (drv (build-expression->derivation store "silent" - (%current-system) - builder '())) + (drv (build-expression->derivation store "silent" builder)) (out-path (derivation->output-path drv))) (guard (c ((nix-protocol-error? c) (and (string-contains (nix-protocol-error-message c) @@ -433,22 +429,19 @@ #f))) (test-assert "build-expression->derivation and derivation-prerequisites-to-build" - (let ((drv (build-expression->derivation %store "fail" (%current-system) - #f '()))) + (let ((drv (build-expression->derivation %store "fail" #f))) ;; The only direct dependency is (%guile-for-build) and it's already ;; built. (null? (derivation-prerequisites-to-build %store drv)))) (test-assert "derivation-prerequisites-to-build when outputs already present" (let* ((builder '(begin (mkdir %output) #t)) - (input-drv (build-expression->derivation %store "input" - (%current-system) - builder '())) + (input-drv (build-expression->derivation %store "input" builder)) (input-path (derivation-output-path (assoc-ref (derivation-outputs input-drv) "out"))) - (drv (build-expression->derivation %store "something" - (%current-system) builder + (drv (build-expression->derivation %store "something" builder + #:inputs `(("i" ,input-drv)))) (output (derivation->output-path drv))) ;; Make sure these things are not already built. @@ -474,8 +467,7 @@ (test-assert "derivation-prerequisites-to-build and substitutes" (let* ((store (open-connection)) (drv (build-expression->derivation store "prereq-subst" - (%current-system) - (random 1000) '())) + (random 1000))) (output (derivation->output-path drv)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) @@ -515,8 +507,7 @@ Deriver: ~a~%" (let* ((builder '(begin (mkdir %output) #f)) ; fail! - (drv (build-expression->derivation %store "fail" (%current-system) - builder '())) + (drv (build-expression->derivation %store "fail" builder)) (out-path (derivation->output-path drv))) (guard (c ((nix-protocol-error? c) ;; Note that the output path may exist at this point, but it @@ -535,9 +526,7 @@ Deriver: ~a~%" (call-with-output-file (assoc-ref %outputs "second") (lambda (p) (display '(world) p))))) - (drv (build-expression->derivation %store "double" - (%current-system) - builder '() + (drv (build-expression->derivation %store "double" builder #:outputs '("out" "second"))) (succeeded? (build-derivations %store (list drv)))) @@ -556,8 +545,8 @@ Deriver: ~a~%" (dup2 (port->fdes p) 1) (execl (string-append cu "/bin/uname") "uname" "-a"))))) - (drv (build-expression->derivation %store "uname" (%current-system) - builder + (drv (build-expression->derivation %store "uname" builder + #:inputs `(("cu" ,%coreutils)))) (succeeded? (build-derivations %store (list drv)))) (and succeeded? @@ -588,8 +577,7 @@ Deriver: ~a~%" (mkdir-p (string-append out "/guile/guix/nix")) #t))) (drv (build-expression->derivation %store "test-with-modules" - (%current-system) - builder '() + builder #:modules '((guix build utils))))) (and (build-derivations %store (list drv)) @@ -605,14 +593,10 @@ Deriver: ~a~%" (lambda (p) (write "hello" p)))) (hash (sha256 (string->utf8 "hello"))) - (input1 (build-expression->derivation %store "fixed" - (%current-system) - builder1 '() + (input1 (build-expression->derivation %store "fixed" builder1 #:hash hash #:hash-algo 'sha256)) - (input2 (build-expression->derivation %store "fixed" - (%current-system) - builder2 '() + (input2 (build-expression->derivation %store "fixed" builder2 #:hash hash #:hash-algo 'sha256)) (succeeded? (build-derivations %store (list input1 input2)))) @@ -630,27 +614,21 @@ Deriver: ~a~%" (lambda (p) (write "hello" p)))) (hash (sha256 (string->utf8 "hello"))) - (input1 (build-expression->derivation %store "fixed" - (%current-system) - builder1 '() + (input1 (build-expression->derivation %store "fixed" builder1 #:hash hash #:hash-algo 'sha256)) - (input2 (build-expression->derivation %store "fixed" - (%current-system) - builder2 '() + (input2 (build-expression->derivation %store "fixed" builder2 #:hash hash #:hash-algo 'sha256)) (builder3 '(let ((input (assoc-ref %build-inputs "input"))) (call-with-output-file %output (lambda (out) (format #f "My input is ~a.~%" input))))) - (final1 (build-expression->derivation %store "final" - (%current-system) - builder3 + (final1 (build-expression->derivation %store "final" builder3 + #:inputs `(("input" ,input1)))) - (final2 (build-expression->derivation %store "final" - (%current-system) - builder3 + (final2 (build-expression->derivation %store "final" builder3 + #:inputs `(("input" ,input2))))) (and (string=? (derivation->output-path final1) (derivation->output-path final2)) @@ -664,8 +642,7 @@ Deriver: ~a~%" (list %bash %mkdir))) (builder '(copy-file "input" %output)) (drv (build-expression->derivation %store "references-graphs" - (%current-system) - builder '() + builder #:references-graphs `(("input" . ,input)))) (out (derivation->output-path drv))) @@ -697,22 +674,17 @@ Deriver: ~a~%" (let* ((joke (package-derivation %store guile-1.8)) (good (package-derivation %store %bootstrap-guile)) (drv1 (build-expression->derivation %store "original-drv1" - (%current-system) #f ; systematically fail - '() #:guile-for-build joke)) (drv2 (build-expression->derivation %store "original-drv2" - (%current-system) '(call-with-output-file %output (lambda (p) - (display "hello" p))) - '())) + (display "hello" p))))) (drv3 (build-expression->derivation %store "drv-to-remap" - (%current-system) '(let ((in (assoc-ref %build-inputs "in"))) (copy-file in %output)) - `(("in" ,drv1)) + #:inputs `(("in" ,drv1)) #:guile-for-build joke)) (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2) (,joke . ,good)))) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 391e7b9da3..d66e132c1f 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -77,6 +77,5 @@ then false; else true; fi guix build -e "(begin (use-modules (guix monads) (guix utils)) (lambda () - (derivation-expression \"test\" (%current-system) - '(mkdir %output) '())))" \ + (derivation-expression \"test\" '(mkdir %output))))" \ --dry-run diff --git a/tests/monads.scm b/tests/monads.scm index 4608deec9e..7fc2aa90c1 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -116,8 +116,9 @@ (mkdir out) (symlink ,guile (string-append out "/guile-rocks")))) - (drv (derivation-expression "rocks" (%current-system) - exp `(("g" ,gdrv)))) + (drv (derivation-expression "rocks" exp + #:inputs + `(("g" ,gdrv)))) (out -> (derivation->output-path drv)) (built? (built-derivations (list drv)))) (return (and built? diff --git a/tests/store.scm b/tests/store.scm index 741803884d..f1a3f160f4 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -236,12 +236,11 @@ Deriver: ~a~%" (let* ((s (open-connection)) (c (random-text)) ; contents of the output (d (build-expression->derivation - s "substitute-me" (%current-system) + s "substitute-me" `(call-with-output-file %output (lambda (p) (exit 1) ; would actually fail (display ,c p))) - '() #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d)) @@ -288,11 +287,10 @@ Deriver: ~a~%" (let* ((s (open-connection)) (t (random-text)) ; contents of the output (d (build-expression->derivation - s "substitute-me-not" (%current-system) + s "substitute-me-not" `(call-with-output-file %output (lambda (p) (display ,t p))) - '() #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d)) diff --git a/tests/union.scm b/tests/union.scm index 54e2850942..3ebf483efa 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -104,8 +104,8 @@ (map cdr %build-inputs)))) (drv (build-expression->derivation %store "union-test" - (%current-system) - builder inputs + builder + #:inputs inputs #:modules '((guix build union))))) (and (build-derivations %store (list (pk 'drv drv))) (with-directory-excursion (derivation->output-path drv)