diff options
Diffstat (limited to 'guix/build-system')
35 files changed, 1935 insertions, 2153 deletions
diff --git a/guix/build-system/android-ndk.scm b/guix/build-system/android-ndk.scm index dbfa626a19..211fd11311 100644 --- a/guix/build-system/android-ndk.scm +++ b/guix/build-system/android-ndk.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +21,8 @@ #:use-module (guix search-paths) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -34,62 +36,51 @@ (guix build syscalls) ,@%gnu-build-system-modules)) -(define* (android-ndk-build store name inputs - #:key - (tests? #t) - (test-target #f) - (phases '(@ (guix build android-ndk-build-system) - %standard-phases)) - (outputs '("out")) - (make-flags ''()) - (search-paths '()) - (system (%current-system)) - (guile #f) - (imported-modules %android-ndk-build-system-modules) - (modules '((guix build android-ndk-build-system) - (guix build utils)))) +(define* (android-ndk-build name inputs + #:key + source + (tests? #t) + (test-target #f) + (phases '%standard-phases) + (outputs '("out")) + (make-flags #~'()) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %android-ndk-build-system-modules) + (modules '((guix build android-ndk-build-system) + (guix build utils)))) "Build SOURCE using Android NDK, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (android-ndk-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:test-target ,test-target - #:tests? ,tests? - #:phases ,phases - #:make-flags (cons* "-f" - ,(string-append - (derivation->output-path - (car (assoc-ref inputs "android-build"))) - "/share/android/build/core/main.mk") - ,make-flags) - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) - (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))))) + (android-ndk-build #:name #$name + #:source #+source + #:system #$system + #:test-target #$test-target + #:tests? #$tests? + #:phases #$phases + #:bootstrap-scripts '() ;no autotools machinery + #:make-flags + (cons* "-f" + #$(file-append (gexp-input-thing + (car (assoc-ref inputs + "android-build"))) + "/share/android/build/core/main.mk") + #$make-flags) + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp inputs))))) - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define* (lower name #:key source inputs native-inputs outputs system target @@ -98,7 +89,7 @@ "Return a bag for NAME." (define private-keywords - '(#:source #:target #:inputs #:native-inputs #:outputs)) + '(#:target #:inputs #:native-inputs #:outputs)) (and (not target) ;; TODO: support cross-compilation (bag diff --git a/guix/build-system/ant.scm b/guix/build-system/ant.scm index 1809d1f3d2..08a4c996f9 100644 --- a/guix/build-system/ant.scm +++ b/guix/build-system/ant.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +21,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -73,7 +75,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:jdk #:ant #:zip #:inputs #:native-inputs)) + '(#:target #:jdk #:ant #:zip #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -94,8 +96,9 @@ (build ant-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (ant-build store name inputs +(define* (ant-build name inputs #:key + source (tests? #t) (test-target "check") (configure-flags ''()) @@ -107,8 +110,7 @@ (test-exclude (list "**/Abstract*.java")) (source-dir "src") (test-dir "src/test") - (phases '(@ (guix build ant-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -119,49 +121,35 @@ (guix build utils)))) "Build SOURCE with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (ant-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:make-flags ,make-flags - #:configure-flags ,configure-flags - #:system ,system - #:tests? ,tests? - #:test-target ,test-target - #:build-target ,build-target - #:jar-name ,jar-name - #:main-class ,main-class - #:test-include (list ,@test-include) - #:test-exclude (list ,@test-exclude) - #:source-dir ,source-dir - #:test-dir ,test-dir - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (ant-build #:name #$name + #:source #+source + #:make-flags #$make-flags + #:configure-flags #$configure-flags + #:system #$system + #:tests? #$tests? + #:test-target #$test-target + #:build-target #$build-target + #:jar-name #$jar-name + #:main-class #$main-class + #:test-include (list #$@test-include) + #:test-exclude (list #$@test-exclude) + #:source-dir #$source-dir + #:test-dir #$test-dir + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp 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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define ant-build-system (build-system diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index b4e40ee8c2..f043e6a7a2 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca> ;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +23,8 @@ #:use-module (guix utils) #:use-module (guix memoization) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module ((guix build utils) #:select ((package-name->name+version @@ -92,46 +94,33 @@ (build asdf-build/source) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (asdf-build/source store name inputs +(define* (asdf-build/source name inputs #:key source outputs - (phases '(@ (guix build asdf-build-system) - %standard-phases/source)) + (phases '%standard-phases/source) (search-paths '()) (system (%current-system)) (guile #f) (imported-modules %asdf-build-system-modules) (modules %asdf-build-modules)) (define builder - `(begin - (use-modules ,@modules) - (asdf-build/source #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) source) - (source source)) - #:system ,system - #: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 - (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)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (asdf-build/source #:name #$name + #:source #+source + #:system #$system + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp inputs))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define* (package-with-build-system from-build-system to-build-system from-prefix to-prefix @@ -277,19 +266,18 @@ set up using CL source package conventions." (arguments (strip-keyword-arguments private-keywords arguments)))))) (define (asdf-build lisp-type) - (lambda* (store name inputs - #:key source outputs - (tests? #t) - (asd-files ''()) - (asd-systems ''()) - (test-asd-file #f) - (phases '(@ (guix build asdf-build-system) - %standard-phases)) - (search-paths '()) - (system (%current-system)) - (guile #f) - (imported-modules %asdf-build-system-modules) - (modules %asdf-build-modules)) + (lambda* (name inputs + #:key source outputs + (tests? #t) + (asd-files ''()) + (asd-systems ''()) + (test-asd-file #f) + (phases '%standard-phases) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %asdf-build-system-modules) + (modules %asdf-build-modules)) (define systems (if (null? (cadr asd-systems)) @@ -304,44 +292,32 @@ set up using CL source package conventions." asd-systems)) (define builder - `(begin - (use-modules ,@modules) - (parameterize ((%lisp (string-append - (assoc-ref %build-inputs ,lisp-type) - "/bin/" ,lisp-type)) - (%lisp-type ,lisp-type)) - (asdf-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) source) - (source source)) - #:asd-files ,asd-files - #:asd-systems ,systems - #:test-asd-file ,test-asd-file - #:system ,system - #: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 - (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))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (parameterize ((%lisp (search-input-file + #$(input-tuples->gexp inputs) + (string-append "bin/" #$lisp-type))) + (%lisp-type #$lisp-type)) + (asdf-build #:name #$name + #:source #+source + #:asd-files #$asd-files + #:asd-systems #$systems + #:test-asd-file #$test-asd-file + #:system #$system + #:tests? #$tests? + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp inputs)))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile)))) (define asdf-build-system/sbcl (build-system diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm index e53d2a7523..60c35eed07 100644 --- a/guix/build-system/cargo.scm +++ b/guix/build-system/cargo.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2019, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2016 David Craven <david@craven.ch> @@ -26,7 +26,8 @@ #:use-module (guix search-paths) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -71,8 +72,9 @@ to NAME and VERSION." (guix build json) ,@%cargo-utils-modules)) -(define* (cargo-build store name inputs +(define* (cargo-build name inputs #:key + source (tests? #t) (test-target #f) (vendor-dir "guix-vendor") @@ -82,8 +84,7 @@ to NAME and VERSION." (features ''()) (skip-build? #f) (install-source? #t) - (phases '(@ (guix build cargo-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -94,47 +95,35 @@ to NAME and VERSION." "Build SOURCE using CARGO, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (cargo-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:test-target ,test-target - #:vendor-dir ,vendor-dir - #:cargo-build-flags ,cargo-build-flags - #:cargo-test-flags ,cargo-test-flags - #:cargo-package-flags ,cargo-package-flags - #:features ,features - #:skip-build? ,skip-build? - #:install-source? ,install-source? - #:tests? ,(and tests? (not skip-build?)) - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) - (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))))) + (cargo-build #:name #$name + #:source #+source + #:system #$system + #:test-target #$test-target + #:vendor-dir #$vendor-dir + #:cargo-build-flags #$(sexp->gexp cargo-build-flags) + #:cargo-test-flags #$(sexp->gexp cargo-test-flags) + #:cargo-package-flags #$(sexp->gexp cargo-package-flags) + #:features #$(sexp->gexp features) + #:skip-build? #$skip-build? + #:install-source? #$install-source? + #:tests? #$(and tests? (not skip-build?)) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:outputs #$(outputs->gexp outputs) + #:inputs #$(input-tuples->gexp inputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)))))) - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (gexp->derivation name builder + #:system system + #:target #f + #:guile-for-build guile)) (define (package-cargo-inputs p) (apply @@ -222,7 +211,7 @@ any dependent crates. This can be a benefits: - It avoids waiting for quadratic builds from source: cargo always builds dependencies within the current workspace. This is largely due to Rust not having a stable ABI and other resolutions that cargo applies. This means that - if we have a depencency chain of X -> Y -> Z and we build each definition + if we have a dependency chain of X -> Y -> Z and we build each definition independently the following will happen: * Cargo will build and test crate Z * Cargo will build crate Z in Y's workspace, then build and test Y @@ -253,7 +242,7 @@ any dependent crates. This can be a benefits: "Return a bag for NAME." (define private-keywords - '(#:source #:target #:rust #:inputs #:native-inputs #:outputs + '(#:target #:rust #:inputs #:native-inputs #:outputs #:cargo-inputs #:cargo-development-inputs)) (and (not target) ;; TODO: support cross-compilation diff --git a/guix/build-system/chicken.scm b/guix/build-system/chicken.scm index 10f1469e88..07666d1321 100644 --- a/guix/build-system/chicken.scm +++ b/guix/build-system/chicken.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 raingloom <raingloom@riseup.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; ;;; This file is part of GNU Guix. @@ -19,7 +20,9 @@ (define-module (guix build-system chicken) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -55,7 +58,7 @@ EXTENSION is the file name extension, such as '.tar.gz'." #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:chicken #:inputs #:native-inputs)) + '(#:target #:chicken #:inputs #:native-inputs)) ;; TODO: cross-compilation support (and (not target) @@ -77,60 +80,45 @@ EXTENSION is the file name extension, such as '.tar.gz'." (build chicken-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (chicken-build store name inputs - #:key - (phases '(@ (guix build chicken-build-system) - %standard-phases)) - (outputs '("out")) - (search-paths '()) - (egg-name "") - (unpack-path "") - (build-flags ''()) - (tests? #t) - (system (%current-system)) - (guile #f) - (imported-modules %chicken-build-system-modules) - (modules '((guix build chicken-build-system) - (guix build union) - (guix build utils)))) +(define* (chicken-build name inputs + #:key + source + (phases '%standard-phases) + (outputs '("out")) + (search-paths '()) + (egg-name "") + (unpack-path "") + (build-flags ''()) + (tests? #t) + (system (%current-system)) + (guile #f) + (imported-modules %chicken-build-system-modules) + (modules '((guix build chicken-build-system) + (guix build union) + (guix build utils)))) (define builder - `(begin - (use-modules ,@modules) - (chicken-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:egg-name ,egg-name - #:unpack-path ,unpack-path - #:build-flags ,build-flags - #:tests? ,tests? - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (chicken-build #:name #$name + #:source #+source + #:system #$system + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:egg-name #$egg-name + #:unpack-path #$unpack-path + #:build-flags #$build-flags + #:tests? #$tests? + #:inputs #$(input-tuples->gexp 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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define chicken-build-system (build-system diff --git a/guix/build-system/clojure.scm b/guix/build-system/clojure.scm index 607f67aaec..39b7f44e89 100644 --- a/guix/build-system/clojure.scm +++ b/guix/build-system/clojure.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com> -;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,7 +25,9 @@ #:select (standard-packages) #:prefix gnu:) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix packages) #:use-module ((guix search-paths) #:select @@ -102,26 +104,9 @@ (arguments (strip-keyword-arguments private-keywords arguments)))))) -(define-with-docs source->output-path - "Convert source input to output path." - (match-lambda - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source))) - -(define-with-docs maybe-guile->guile - "Find the right guile." - (match-lambda - ((and maybe-guile (? package?)) - maybe-guile) - (#f ; default - (@* (gnu packages commencement) guile-final)))) - -(define* (clojure-build store name inputs +(define* (clojure-build name inputs #:key + source (source-dirs `',%source-dirs) (test-dirs `',%test-dirs) (compile-dir %compile-dir) @@ -133,7 +118,7 @@ (aot-include `',%aot-include) (aot-exclude `',%aot-exclude) - doc-dirs ; no sensible default + doc-dirs ; no sensible default (doc-regex %doc-regex) (tests? %tests?) @@ -149,48 +134,45 @@ (imported-modules %clojure-build-system-modules) (modules %default-modules)) "Build SOURCE with INPUTS." - (let ((builder `(begin - (use-modules ,@modules) - (clojure-build #:name ,name - #:source ,(source->output-path - (assoc-ref inputs "source")) - - #:source-dirs ,source-dirs - #:test-dirs ,test-dirs - #:compile-dir ,compile-dir - - #:jar-names ,jar-names - #:main-class ,main-class - #:omit-source? ,omit-source? - - #:aot-include ,aot-include - #:aot-exclude ,aot-exclude - - #:doc-dirs ,doc-dirs - #:doc-regex ,doc-regex - - #:tests? ,tests? - #:test-include ,test-include - #:test-exclude ,test-exclude - - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-spec->sexp - search-paths) - #:system ,system - #:inputs %build-inputs))) - - (guile-for-build (package-derivation store - (maybe-guile->guile 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 builder + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (clojure-build #:name #$name + #:source #+source + + #:source-dirs #$source-dirs + #:test-dirs #$test-dirs + #:compile-dir #$compile-dir + + #:jar-names #$jar-names + #:main-class #$main-class + #:omit-source? #$omit-source? + + #:aot-include #$aot-include + #:aot-exclude #$aot-exclude + + #:doc-dirs #$doc-dirs + #:doc-regex #$doc-regex + + #:tests? #$tests? + #:test-include #$test-include + #:test-exclude #$test-exclude + + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-spec->sexp + search-paths)) + #:system #$system + #:inputs #$(input-tuples->gexp inputs))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define clojure-build-system (build-system diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index f590b6ea42..2056c04153 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> @@ -21,7 +21,9 @@ (define-module (guix build-system cmake) #:use-module (guix store) + #:use-module (guix gexp) #:use-module (guix utils) + #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) @@ -61,7 +63,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - `(#:source #:cmake #:inputs #:native-inputs #:outputs + `(#:cmake #:inputs #:native-inputs ,@(if target '() '(#:target)))) (bag @@ -95,8 +97,8 @@ (build (if target cmake-cross-build cmake-build)) (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (cmake-build store name inputs - #:key (guile #f) +(define* (cmake-build name inputs + #:key guile source (outputs '("out")) (configure-flags ''()) (search-paths '()) (make-flags ''()) @@ -111,8 +113,7 @@ (strip-flags ''("--strip-debug")) (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) - (phases '(@ (guix build cmake-build-system) - %standard-phases)) + (phases '%standard-phases) (system (%current-system)) (substitutable? #t) (imported-modules %cmake-build-system-modules) @@ -120,62 +121,57 @@ (guix build utils)))) "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its build system." - (define builder - `(begin - (use-modules ,@modules) - (cmake-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:configure-flags ,configure-flags - #:make-flags ,make-flags - #:out-of-source? ,out-of-source? - #:build-type ,build-type - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) + (define build + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) - (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))))) + #$(with-build-variables inputs outputs + #~(cmake-build #:source #+source + #:system #$system + #:outputs %outputs + #:inputs %build-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:configure-flags #$(if (pair? configure-flags) + (sexp->gexp configure-flags) + configure-flags) + #:make-flags #$make-flags + #:out-of-source? #$out-of-source? + #:build-type #$build-type + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories #$(sexp->gexp strip-directories)))))) - (build-expression->derivation store name builder - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:substitutable? substitutable? - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name build + #:system system + #:target #f + #:graft? #f + #:substitutable? substitutable? + #:guile-for-build guile))) ;;; ;;; Cross-compilation. ;;; -(define* (cmake-cross-build store name +(define* (cmake-cross-build name #:key - target native-drvs target-drvs - (guile #f) + target + build-inputs target-inputs host-inputs + source guile (outputs '("out")) (configure-flags ''()) (search-paths '()) @@ -193,8 +189,7 @@ provides a 'CMakeLists.txt' file as its build system." "--enable-deterministic-archives")) (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) - (phases '(@ (guix build cmake-build-system) - %standard-phases)) + (phases '%standard-phases) (substitutable? #t) (system (%current-system)) (build (nix-system->gnu-triplet system)) @@ -205,78 +200,58 @@ provides a 'CMakeLists.txt' file as its build system." with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its build system." (define builder - `(begin - (use-modules ,@modules) - (let () - (define %build-host-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name path) - `(,name . ,path))) - native-drvs)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define %build-host-inputs + #+(input-tuples->gexp build-inputs)) + + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs))) - (define %build-target-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name (? package? pkg) sub ...) - (let ((drv (package-cross-derivation store pkg - target system))) - `(,name . ,(apply derivation->output-path drv sub)))) - ((name path) - `(,name . ,path))) - target-drvs)) + (define %build-inputs + (append %build-host-inputs %build-target-inputs)) - (cmake-build #:source ,(match (assoc-ref native-drvs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:build ,build - #:target ,target - #:outputs %outputs - #:inputs %build-target-inputs - #:native-inputs %build-host-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:native-search-paths ',(map - search-path-specification->sexp - native-search-paths) - #:phases ,phases - #:configure-flags ,configure-flags - #:make-flags ,make-flags - #:out-of-source? ,out-of-source? - #:build-type ,build-type - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories)))) + (define %outputs + #$(outputs->gexp outputs)) - (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))))) + (cmake-build #:source #+source + #:system #$system + #:build #$build + #:target #$target + #:outputs %outputs + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths '#$(map search-path-specification->sexp + search-paths) + #:native-search-paths '#$(map + search-path-specification->sexp + native-search-paths) + #:phases #$phases + #:configure-flags #$configure-flags + #:make-flags #$make-flags + #:out-of-source? #$out-of-source? + #:build-type #$build-type + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories)))) - (build-expression->derivation store name builder - #:system system - #:inputs (append native-drvs target-drvs) - #:outputs outputs - #:modules imported-modules - #:substitutable? substitutable? - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target target + #:graft? #f + #:substitutable? substitutable? + #:guile-for-build guile))) (define cmake-build-system (build-system diff --git a/guix/build-system/copy.scm b/guix/build-system/copy.scm index d1bf8fb654..4894ba46fb 100644 --- a/guix/build-system/copy.scm +++ b/guix/build-system/copy.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +21,8 @@ (define-module (guix build-system copy) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -59,7 +61,7 @@ #:rest arguments) "Return a bag for NAME from the given arguments." (define private-keywords - '(#:source #:target #:inputs #:native-inputs)) + '(#:target #:inputs #:native-inputs)) (bag (name name) @@ -75,8 +77,9 @@ (build copy-build) (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (copy-build store name inputs - #:key (guile #f) +(define* (copy-build name inputs + #:key + guile source (outputs '("out")) (install-plan ''(("." "./"))) (search-paths '()) @@ -90,49 +93,43 @@ (phases '(@ (guix build copy-build-system) %standard-phases)) (system (%current-system)) + (target #f) (imported-modules %copy-build-system-modules) (modules '((guix build copy-build-system) (guix build utils)))) "Build SOURCE using INSTALL-PLAN, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (copy-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:install-plan ,install-plan - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:out-of-source? ,out-of-source? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@modules) - (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))))) + #$(with-build-variables inputs outputs + #~(copy-build #:source #+source + #:system #$system + #:outputs %outputs + #:inputs %build-inputs + #:install-plan #$(if (pair? install-plan) + (sexp->gexp install-plan) + install-plan) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:out-of-source? #$out-of-source? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories #$(sexp->gexp strip-directories)))))) - (build-expression->derivation store name builder - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target #f + #:guile-for-build guile))) (define copy-build-system (build-system diff --git a/guix/build-system/dub.scm b/guix/build-system/dub.scm index 5a31a2f51a..55ad7decb8 100644 --- a/guix/build-system/dub.scm +++ b/guix/build-system/dub.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2016 David Craven <david@craven.ch> @@ -24,7 +24,8 @@ #:use-module (guix search-paths) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -56,57 +57,43 @@ (guix build syscalls) ,@%gnu-build-system-modules)) -(define* (dub-build store name inputs - #:key - (tests? #t) - (test-target #f) - (dub-build-flags ''()) - (phases '(@ (guix build dub-build-system) - %standard-phases)) - (outputs '("out")) - (search-paths '()) - (system (%current-system)) - (guile #f) - (imported-modules %dub-build-system-modules) - (modules '((guix build dub-build-system) - (guix build utils)))) +(define* (dub-build name inputs + #:key + source + (tests? #t) + (test-target #f) + (dub-build-flags ''()) + (phases '%standard-phases) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %dub-build-system-modules) + (modules '((guix build dub-build-system) + (guix build utils)))) "Build SOURCE using DUB, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (dub-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:test-target ,test-target - #:dub-build-flags ,dub-build-flags - #:tests? ,tests? - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (dub-build #:name #$name + #:source #+source + #:system #$system + #:test-target #$test-target + #:dub-build-flags #$dub-build-flags + #:tests? #$tests? + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp 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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define* (lower name #:key source inputs native-inputs outputs system target @@ -118,7 +105,7 @@ "Return a bag for NAME." (define private-keywords - '(#:source #:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs)) + '(#:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs)) (and (not target) ;; TODO: support cross-compilation (bag diff --git a/guix/build-system/dune.scm b/guix/build-system/dune.scm index 5b33ef6841..12100fd8e8 100644 --- a/guix/build-system/dune.scm +++ b/guix/build-system/dune.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 pukkamustard <pukkamustard@posteo.net> ;;; ;;; This file is part of GNU Guix. @@ -21,7 +22,7 @@ (define-module (guix build-system dune) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module ((guix build-system gnu) #:prefix gnu:) @@ -72,7 +73,7 @@ "--profile" "release"))) (define private-keywords - '(#:source #:target #:dune #:findlib #:ocaml #:inputs #:native-inputs)) + '(#:target #:dune #:findlib #:ocaml #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (let ((base (ocaml:lower name @@ -94,8 +95,9 @@ `(#:dune-release-flags ,dune-release-flags) (strip-keyword-arguments private-keywords arguments))))))) -(define* (dune-build store name inputs - #:key (guile #f) +(define* (dune-build name inputs + #:key + guile source (outputs '("out")) (search-paths '()) (build-flags ''()) @@ -122,51 +124,40 @@ "Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE provides a 'setup.ml' file as its build system." (define builder - `(begin - (use-modules ,@modules) - (dune-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:test-flags ,test-flags - #:build-flags ,build-flags - #:out-of-source? ,out-of-source? - #:jbuild? ,jbuild? - #:package ,package - #:dune-release-flags ,dune-release-flags - #:tests? ,tests? - #:test-target ,test-target - #:install-target ,install-target - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@modules) + (dune-build #:source #$source + #:system #$system + #:outputs (list #$@(map (lambda (name) + #~(cons #$name + (ungexp output name))) + outputs)) + #:inputs (map (lambda (tuple) + (apply cons tuple)) + '#$inputs) + #:search-paths '#$(map search-path-specification->sexp + search-paths) + #:phases #$phases + #:test-flags #$test-flags + #:build-flags #$build-flags + #:out-of-source? #$out-of-source? + #:jbuild? #$jbuild? + #:package #$package + #:dune-release-flags #$dune-release-flags + #:tests? #$tests? + #:test-target #$test-target + #:install-target #$install-target + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories)))) - (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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (gexp->derivation name builder + #:system system + #:target #f + #:guile-for-build guile)) (define dune-build-system (build-system diff --git a/guix/build-system/emacs.scm b/guix/build-system/emacs.scm index ac05ff420e..3df68789ff 100644 --- a/guix/build-system/emacs.scm +++ b/guix/build-system/emacs.scm @@ -23,7 +23,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -81,13 +82,12 @@ (build emacs-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (emacs-build store name inputs +(define* (emacs-build name inputs #:key source (tests? #f) (parallel-tests? #t) (test-command ''("make" "check")) - (phases '(@ (guix build emacs-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (include (quote %default-include)) (exclude (quote %default-exclude)) @@ -100,43 +100,29 @@ (guix build emacs-utils)))) "Build SOURCE using EMACS, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (emacs-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:test-command ,test-command - #:tests? ,tests? - #:parallel-tests? ,parallel-tests? - #:phases ,phases - #:outputs %outputs - #:include ,include - #:exclude ,exclude - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (emacs-build #:name #$name + #:source #+source + #:system #$system + #:test-command #$test-command + #:tests? #$tests? + #:parallel-tests? #$parallel-tests? + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:include #$include + #:exclude #$exclude + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp 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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define emacs-build-system (build-system diff --git a/guix/build-system/font.scm b/guix/build-system/font.scm index d40a4985f8..74dc80b5db 100644 --- a/guix/build-system/font.scm +++ b/guix/build-system/font.scm @@ -17,6 +17,9 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build-system font) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix derivations) @@ -69,13 +72,12 @@ (build font-build) (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (font-build store name inputs +(define* (font-build name inputs #:key source (tests? #t) (test-target "test") (configure-flags ''()) - (phases '(@ (guix build font-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -85,41 +87,32 @@ (guix build utils)))) "Build SOURCE with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (font-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))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@modules) - (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))))) + #$(with-build-variables inputs outputs + #~(font-build #:name #$name + #:source #+source + #:configure-flags #$configure-flags + #:system #$system + #:test-target #$test-target + #:tests? #$tests? + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:outputs %outputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs %build-inputs))))) - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target #f + #:guile-for-build guile))) (define font-build-system (build-system diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm index fb1f8fb930..aa9703829b 100644 --- a/guix/build-system/glib-or-gtk.scm +++ b/guix/build-system/glib-or-gtk.scm @@ -1,7 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,15 +22,21 @@ (define-module (guix build-system glib-or-gtk) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix search-paths) + #:use-module ((guix build glib-or-gtk-build-system) + #:select (%gdk-pixbuf-loaders-cache-file)) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (guix packages) #:use-module (ice-9 match) #:export (%glib-or-gtk-build-system-modules glib-or-gtk-build - glib-or-gtk-build-system)) + glib-or-gtk-cross-build + glib-or-gtk-build-system) + #:re-export (%gdk-pixbuf-loaders-cache-file)) ;for convenience ;; Commentary: ;; @@ -80,33 +87,45 @@ #:key source inputs native-inputs outputs system target (glib (default-glib)) (implicit-inputs? #t) + (implicit-cross-inputs? #t) (strip-binaries? #t) #:allow-other-keys #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:glib #:inputs #:native-inputs - #:outputs #:implicit-inputs?)) - - (and (not target) ;XXX: no cross-compilation - (bag - (name name) - (system system) - (host-inputs (if source - `(("source" ,source)) - '())) - (build-inputs `(,@native-inputs - ,@inputs - ("glib:bin" ,glib "bin") ; to compile schemas - ,@(if implicit-inputs? - (standard-packages) - '()))) - (outputs outputs) - (build glib-or-gtk-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) - -(define* (glib-or-gtk-build store name inputs - #:key (guile #f) + `(#:glib #:inputs #:native-inputs + #:outputs #:implicit-inputs? #:implicit-cross-inputs? + ,@(if target '() '(#:target)))) + + (bag + (name name) + (system system) (target target) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@(if target + inputs + '()))) + (build-inputs `(,@native-inputs + ,@(if target '() inputs) + ("glib:bin" ,glib "bin") ; to compile schemas + ;; Keep standard inputs of gnu-build-system. + ,@(if (and target implicit-cross-inputs?) + (standard-cross-packages target 'host) + '()) + ,@(if implicit-inputs? + (standard-packages) + '()))) + ;; Keep standard inputs of 'gnu-build-system'. + (target-inputs (if (and target implicit-cross-inputs?) + (standard-cross-packages target 'target) + '())) + (outputs outputs) + (build (if target glib-or-gtk-cross-build glib-or-gtk-build)) + (arguments (strip-keyword-arguments private-keywords arguments)))) + +(define* (glib-or-gtk-build name inputs + #:key guile source (outputs '("out")) (search-paths '()) (configure-flags ''()) @@ -132,70 +151,143 @@ allowed-references disallowed-references) "Build SOURCE with INPUTS. See GNU-BUILD for more details." - (define canonicalize-reference - (match-lambda - ((? package? p) - (derivation->output-path (package-derivation store p system))) - (((? package? p) output) - (derivation->output-path (package-derivation store p system) - output)) - ((? string? output) - output))) + (define build + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + #$(with-build-variables inputs outputs + #~(glib-or-gtk-build #:source #+source + #:system #$system + #:outputs %outputs + #:inputs %build-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:glib-or-gtk-wrap-excluded-outputs + #$glib-or-gtk-wrap-excluded-outputs + #:configure-flags #$configure-flags + #:make-flags #$make-flags + #:out-of-source? #$out-of-source? + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories + #$(sexp->gexp strip-directories)))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name build + #:system system + #:target #f + #:graft? #f + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) + +(define* (glib-or-gtk-cross-build name + #:key + target + build-inputs target-inputs host-inputs + guile source + (outputs '("out")) + (search-paths '()) + (native-search-paths '()) + (configure-flags ''()) + ;; Disable icon theme cache generation. + (make-flags ''("gtk_update_icon_cache=true")) + (out-of-source? #f) + (tests? #f) + (test-target "check") + (parallel-build? #t) + (parallel-tests? #t) + (validate-runpath? #t) + (make-dynamic-linker-cache? #f) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build glib-or-gtk-build-system) + %standard-phases)) + (glib-or-gtk-wrap-excluded-outputs ''()) + (system (%current-system)) + (build (nix-system->gnu-triplet system)) + (imported-modules %glib-or-gtk-build-system-modules) + (modules %default-modules) + allowed-references + disallowed-references) + "Cross-build SOURCE with INPUTS. See GNU-BUILD for more details." (define builder - `(begin - (use-modules ,@modules) - (glib-or-gtk-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:glib-or-gtk-wrap-excluded-outputs - ,glib-or-gtk-wrap-excluded-outputs - #:configure-flags ,configure-flags - #:make-flags ,make-flags - #:out-of-source? ,out-of-source? - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) - - (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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:allowed-references - (and allowed-references - (map canonicalize-reference - allowed-references)) - #:disallowed-references - (and disallowed-references - (map canonicalize-reference - disallowed-references)) - #:guile-for-build guile-for-build)) + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define %build-host-inputs + #+(input-tuples->gexp build-inputs)) + + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs))) + + (define %build-inputs + (append %build-host-inputs %build-target-inputs)) + + (define %outputs + #$(outputs->gexp outputs)) + + (glib-or-gtk-build #:source #+source + #:system #$system + #:build #$build + #:target #$target + #:outputs %outputs + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:native-search-paths '#$(sexp->gexp + (map search-path-specification->sexp + native-search-paths)) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:glib-or-gtk-wrap-excluded-outputs + #$glib-or-gtk-wrap-excluded-outputs + #:configure-flags #$configure-flags + #:make-flags #$make-flags + #:out-of-source? #$out-of-source? + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:make-dynamic-linker-cache? #$make-dynamic-linker-cache? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories + #$(sexp->gexp strip-directories)))) + + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target target + #:graft? #f + #:modules imported-modules + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) (define glib-or-gtk-build-system (build-system diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 6b481ad45c..651415098e 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix memoization) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) @@ -215,7 +217,7 @@ use `--strip-all' as the arguments to `strip'." (arguments (let ((a (default-keyword-arguments (package-arguments p) '(#:configure-flags '() - #:strip-flags '("--strip-debug"))))) + #:strip-flags '("--strip-unneeded"))))) (substitute-keyword-arguments a ((#:configure-flags flags) `(cons* "--disable-shared" "LDFLAGS=-static" ,flags)) @@ -281,7 +283,7 @@ standard packages used as implicit inputs of the GNU build system." #:rest arguments) "Return a bag for NAME from the given arguments." (define private-keywords - `(#:source #:inputs #:native-inputs #:outputs + `(#:inputs #:native-inputs #:outputs #:implicit-inputs? #:implicit-cross-inputs? ,@(if target '() '(#:target)))) @@ -324,10 +326,22 @@ standard packages used as implicit inputs of the GNU build system." ;; Regexp matching license files. "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$") -(define* (gnu-build store name input-drvs - #:key (guile #f) +(define %bootstrap-scripts + ;; Typical names of Autotools "bootstrap" scripts. + #~%bootstrap-scripts) + +(define %strip-flags + #~'("--strip-unneeded" "--enable-deterministic-archives")) + +(define %strip-directories + #~'("lib" "lib64" "libexec" "bin" "sbin")) + +(define* (gnu-build name inputs + #:key + guile source (outputs '("out")) (search-paths '()) + (bootstrap-scripts %bootstrap-scripts) (configure-flags ''()) (make-flags ''()) (out-of-source? #f) @@ -337,11 +351,10 @@ standard packages used as implicit inputs of the GNU build system." (parallel-tests? #t) (patch-shebangs? #t) (strip-binaries? #t) - (strip-flags ''("--strip-debug" - "--enable-deterministic-archives")) - (strip-directories ''("lib" "lib64" "libexec" - "bin" "sbin")) + (strip-flags %strip-flags) + (strip-directories %strip-directories) (validate-runpath? #t) + (make-dynamic-linker-cache? #t) (license-file-regexp %license-file-regexp) (phases '%standard-phases) (locale "en_US.utf8") @@ -368,78 +381,58 @@ SUBSTITUTABLE? determines whether users may be able to use substitutes of the returned derivations, or whether they should always build it locally. ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs -are allowed to refer to. Likewise for DISALLOWED-REFERENCES, which lists -packages that must not be referenced." - (define canonicalize-reference - (match-lambda - ((? package? p) - (derivation->output-path (package-derivation store p system - #:graft? #f))) - (((? package? p) output) - (derivation->output-path (package-derivation store p system - #:graft? #f) - output)) - ((? string? output) - output))) - +are allowed to refer to." (define builder - `(begin - (use-modules ,@modules) - (gnu-build #:source ,(match (assoc-ref input-drvs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:build ,build - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:locale ,locale - #:configure-flags ,configure-flags - #:make-flags ,make-flags - #:out-of-source? ,out-of-source? - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:validate-runpath? ,validate-runpath? - #:license-file-regexp ,license-file-regexp - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) - - (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 - #:system system - #:inputs input-drvs - #:outputs outputs - #:modules imported-modules - #:substitutable? substitutable? - - #:allowed-references - (and allowed-references - (map canonicalize-reference - allowed-references)) - #:disallowed-references - (and disallowed-references - (map canonicalize-reference - disallowed-references)) - #:guile-for-build guile-for-build)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + #$(with-build-variables inputs outputs + #~(gnu-build #:source #+source + #:system #$system + #:build #$build + #:outputs %outputs + #:inputs %build-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:locale #$locale + #:bootstrap-scripts #$bootstrap-scripts + #:configure-flags #$(if (pair? configure-flags) + (sexp->gexp configure-flags) + configure-flags) + #:make-flags #$(if (pair? make-flags) + (sexp->gexp make-flags) + make-flags) + #:out-of-source? #$out-of-source? + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:patch-shebangs? #$patch-shebangs? + #:license-file-regexp #$license-file-regexp + #:strip-binaries? #$strip-binaries? + #:validate-runpath? #$validate-runpath? + #:make-dynamic-linker-cache? #$make-dynamic-linker-cache? + #:license-file-regexp #$license-file-regexp + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + ;; Note: Always pass #:graft? #f. Without it, ALLOWED-REFERENCES & + ;; co. would be interpreted as referring to grafted packages. + (gexp->derivation name builder + #:system system + #:target #f + #:graft? #f + #:substitutable? substitutable? + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) ;;; @@ -475,15 +468,16 @@ is one of `host' or `target'." `(("cross-libc:static" ,libc "static")) '())))))))) -(define* (gnu-cross-build store name +(define* (gnu-cross-build name #:key - target native-drvs target-drvs - (guile #f) - source + target + build-inputs target-inputs host-inputs + guile source (outputs '("out")) (search-paths '()) (native-search-paths '()) + (bootstrap-scripts %bootstrap-scripts) (configure-flags ''()) (make-flags ''()) (out-of-source? #f) @@ -492,11 +486,15 @@ is one of `host' or `target'." (parallel-build? #t) (parallel-tests? #t) (patch-shebangs? #t) (strip-binaries? #t) - (strip-flags ''("--strip-debug" - "--enable-deterministic-archives")) - (strip-directories ''("lib" "lib64" "libexec" - "bin" "sbin")) + (strip-flags %strip-flags) + (strip-directories %strip-directories) (validate-runpath? #t) + + ;; We run 'ldconfig' to generate ld.so.cache and it + ;; generally can't do that for cross-built binaries + ;; ("ldconfig: foo.so is for unknown machine 40."). + (make-dynamic-linker-cache? #f) + (license-file-regexp %license-file-regexp) (phases '%standard-phases) (locale "en_US.utf8") @@ -510,102 +508,67 @@ is one of `host' or `target'." "Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are cross-built inputs, and NATIVE-INPUTS are inputs that run on the build platform." - (define canonicalize-reference - (match-lambda - ((? package? p) - (derivation->output-path (package-cross-derivation store p - target system))) - (((? package? p) output) - (derivation->output-path (package-cross-derivation store p - target system) - output)) - ((? string? output) - output))) - (define builder - `(begin - (use-modules ,@modules) - - (let () - (define %build-host-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name path) - `(,name . ,path))) - native-drvs)) - - (define %build-target-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name (? package? pkg) sub ...) - (let ((drv (package-cross-derivation store pkg - target system))) - `(,name . ,(apply derivation->output-path drv sub)))) - ((name path) - `(,name . ,path))) - target-drvs)) - - (gnu-build #:source ,(match (assoc-ref native-drvs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:build ,build - #:target ,target - #:outputs %outputs - #:inputs %build-target-inputs - #:native-inputs %build-host-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:native-search-paths ',(map - search-path-specification->sexp - native-search-paths) - #:phases ,phases - #:locale ,locale - #:configure-flags ,configure-flags - #:make-flags ,make-flags - #:out-of-source? ,out-of-source? - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:validate-runpath? ,validate-runpath? - #:license-file-regexp ,license-file-regexp - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories)))) - - (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 - #:system system - #:inputs (append native-drvs target-drvs) - #:outputs outputs - #:modules imported-modules - #:substitutable? substitutable? - - #:allowed-references - (and allowed-references - (map canonicalize-reference - allowed-references)) - #:disallowed-references - (and disallowed-references - (map canonicalize-reference - disallowed-references)) - #:guile-for-build guile-for-build)) + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define %build-host-inputs + #+(input-tuples->gexp build-inputs)) + + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs))) + + (define %build-inputs + (append %build-host-inputs %build-target-inputs)) + + (define %outputs + #$(outputs->gexp outputs)) + + (gnu-build #:source #+source + #:system #$system + #:build #$build + #:target #$target + #:outputs %outputs + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:native-search-paths '#$(sexp->gexp + (map + search-path-specification->sexp + native-search-paths)) + #:phases #$phases + #:locale #$locale + #:bootstrap-scripts #$bootstrap-scripts + #:configure-flags #$configure-flags + #:make-flags #$make-flags + #:out-of-source? #$out-of-source? + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:patch-shebangs? #$patch-shebangs? + #:license-file-regexp #$license-file-regexp + #:strip-binaries? #$strip-binaries? + #:validate-runpath? #$validate-runpath? + #:make-dynamic-linker-cache? #$make-dynamic-linker-cache? + #:license-file-regexp #$license-file-regexp + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target target + #:graft? #f + #:modules imported-modules + #:substitutable? substitutable? + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) (define gnu-build-system (build-system diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm index 757e63afe9..8cdcb61028 100644 --- a/guix/build-system/go.scm +++ b/guix/build-system/go.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016 Petter <petter@mykolab.ch> ;;; Copyright © 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. @@ -21,7 +22,9 @@ (define-module (guix build-system go) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -116,7 +119,7 @@ commit hash and its date rather than a proper release tag." #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:go #:inputs #:native-inputs)) + '(#:target #:go #:inputs #:native-inputs)) (bag (name name) @@ -150,10 +153,10 @@ commit hash and its date rather than a proper release tag." (build (if target go-cross-build go-build)) (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (go-build store name inputs +(define* (go-build name inputs #:key - (phases '(@ (guix build go-build-system) - %standard-phases)) + source + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (install-source? #t) @@ -171,47 +174,32 @@ commit hash and its date rather than a proper release tag." (guix build union) (guix build utils)))) (define builder - `(begin - (use-modules ,@modules) - (go-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:phases ,phases - #:outputs %outputs - #:goarch ,goarch - #:goos ,goos - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:install-source? ,install-source? - #:import-path ,import-path - #:unpack-path ,unpack-path - #:build-flags ,build-flags - #:tests? ,tests? - #:allow-go-reference? ,allow-go-reference? - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@modules) + (go-build #:name #$name + #:source #+source + #:system #$system + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:goarch #$goarch + #:goos #$goos + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:install-source? #$install-source? + #:import-path #$import-path + #:unpack-path #$unpack-path + #:build-flags #$build-flags + #:tests? #$tests? + #:allow-go-reference? #$allow-go-reference? + #:inputs #$(input-tuples->gexp 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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define* (go-cross-build store name #:key diff --git a/guix/build-system/guile.scm b/guix/build-system/guile.scm index 45e735b987..f64f214675 100644 --- a/guix/build-system/guile.scm +++ b/guix/build-system/guile.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +20,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -75,7 +76,7 @@ ;; denominator between Guile 2.0 and 2.2. ''("-Wunbound-variable" "-Warity-mismatch" "-Wformat")) -(define* (guile-build store name inputs +(define* (guile-build name inputs #:key source (guile #f) (phases '%standard-phases) @@ -91,47 +92,34 @@ (guix build utils)))) "Build SOURCE using Guile taken from the native inputs, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (guile-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:source-directory ,source-directory - #:scheme-file-regexp ,scheme-file-regexp - #:not-compiled-file-regexp ,not-compiled-file-regexp - #:compile-flags ,compile-flags - #:phases ,phases - #:system ,system - #: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* (guile-cross-build store name + (with-imported-modules imported-modules + #~(begin + (use-modules #$@modules) + + (guile-build #:name #$name + #:source #+source + #:source-directory #$source-directory + #:scheme-file-regexp #$scheme-file-regexp + #:not-compiled-file-regexp #$not-compiled-file-regexp + #:compile-flags #$compile-flags + #:phases #$phases + #:system #$system + #:outputs #$(outputs->gexp outputs) + #:inputs #$(input-tuples->gexp inputs) + #:search-paths '#$(map search-path-specification->sexp + search-paths))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target #f + #:guile-for-build guile))) + +(define* (guile-cross-build name #:key (system (%current-system)) target - native-drvs target-drvs + build-inputs target-inputs host-inputs (guile #f) source (outputs '("out")) @@ -146,68 +134,42 @@ (modules '((guix build guile-build-system) (guix build utils)))) (define builder - `(begin - (use-modules ,@modules) - - (let () - (define %build-host-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name path) - `(,name . ,path))) - native-drvs)) - - (define %build-target-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name (? package? pkg) sub ...) - (let ((drv (package-cross-derivation store pkg - target system))) - `(,name . ,(apply derivation->output-path drv sub)))) - ((name path) - `(,name . ,path))) - target-drvs)) - - (guile-build #:source ,(match (assoc-ref native-drvs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:target ,target - #:outputs %outputs - #:source-directory ,source-directory - #:not-compiled-file-regexp ,not-compiled-file-regexp - #:compile-flags ,compile-flags - #:inputs %build-target-inputs - #:native-inputs %build-host-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:native-search-paths ',(map - search-path-specification->sexp - native-search-paths) - #:phases ,phases)))) - - (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 - #:system system - #:inputs (append native-drvs target-drvs) - #:outputs outputs - #:modules imported-modules - #:substitutable? substitutable? - #:guile-for-build guile-for-build)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@modules) + + (define %build-host-inputs + #+(input-tuples->gexp build-inputs)) + + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs))) + + (define %outputs + #$(outputs->gexp outputs)) + + (guile-build #:source #+source + #:system #$system + #:target #$target + #:outputs %outputs + #:source-directory #$source-directory + #:not-compiled-file-regexp #$not-compiled-file-regexp + #:compile-flags #$compile-flags + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths '#$(map search-path-specification->sexp + search-paths) + #:native-search-paths '#$(map + search-path-specification->sexp + native-search-paths) + #:phases #$phases)))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target target + #:guile-for-build guile))) (define guile-build-system (build-system diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm index 18a584f782..3770304745 100644 --- a/guix/build-system/haskell.scm +++ b/guix/build-system/haskell.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +23,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix download) #:use-module (guix search-paths) #:use-module (guix build-system) @@ -116,7 +118,7 @@ version REVISION." (cons name propagated-names)))))) extra-directories)))))))) -(define* (haskell-build store name inputs +(define* (haskell-build name inputs #:key source (haddock? #t) (haddock-flags ''()) @@ -127,8 +129,7 @@ version REVISION." (parallel-build? #f) (configure-flags ''()) (extra-directories ''()) - (phases '(@ (guix build haskell-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out" "static")) (search-paths '()) (system (%current-system)) @@ -139,50 +140,43 @@ version REVISION." "Build SOURCE using HASKELL, and with INPUTS. This assumes that SOURCE provides a 'Setup.hs' file as its build system." (define builder - `(begin - (use-modules ,@modules) - (haskell-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:cabal-revision ,(match (assoc-ref inputs - "cabal-revision") - (((? derivation? revision)) - (derivation->output-path revision)) - (revision revision)) - #:configure-flags ,configure-flags - #:extra-directories ,extra-directories - #:haddock-flags ,haddock-flags - #:system ,system - #:test-target ,test-target - #:tests? ,tests? - #:parallel-build? ,parallel-build? - #:haddock? ,haddock? - #: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)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + #$(with-build-variables inputs outputs + #~(haskell-build #:name #$name + #:source #+source + + ;; XXX: INPUTS contains <gexp-input> records as + ;; opposed to raw lowerable objects, hence the + ;; use of ungexp-splicing. + #:cabal-revision + #$@(match (assoc-ref inputs "cabal-revision") + (#f '(#f)) + (lst lst)) + + #:configure-flags #$configure-flags + #:extra-directories #$extra-directories + #:extra-directories #$extra-directories + #:haddock-flags #$haddock-flags + #:system #$system + #:test-target #$test-target + #:tests? #$tests? + #:parallel-build? #$parallel-build? + #:haddock? #$haddock? + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp inputs)))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define haskell-build-system (build-system diff --git a/guix/build-system/julia.scm b/guix/build-system/julia.scm index 8ceac090c7..2998663df1 100644 --- a/guix/build-system/julia.scm +++ b/guix/build-system/julia.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me> ;;; ;;; This file is part of GNU Guix. @@ -21,7 +22,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -74,11 +76,10 @@ (build julia-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (julia-build store name inputs +(define* (julia-build name inputs #:key source (tests? #t) - (phases '(@ (guix build julia-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -90,41 +91,27 @@ (guix build utils)))) "Build SOURCE using Julia, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (julia-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:tests? ,tests? - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs - #:julia-package-name ,julia-package-name - #:julia-package-uuid ,julia-package-uuid))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (julia-build #:name #$name + #:source #+source + #:system #$system + #:tests? #$tests? + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp inputs) + #:julia-package-name #$julia-package-name + #:julia-package-uuid #$julia-package-uuid)))) - (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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define julia-build-system (build-system diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm index 548ed7a9aa..0eab919deb 100644 --- a/guix/build-system/linux-module.scm +++ b/guix/build-system/linux-module.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. @@ -21,7 +22,8 @@ (define-module (guix build-system linux-module) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -115,7 +117,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - `(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs + `(#:target #:gcc #:kmod #:linux #:inputs #:native-inputs ,@(if target '() '(#:target)))) (bag @@ -149,13 +151,12 @@ (build (if target linux-module-build-cross linux-module-build)) (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (linux-module-build store name inputs +(define* (linux-module-build name inputs #:key - target + source target (search-paths '()) (tests? #t) - (phases '(@ (guix build linux-module-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (make-flags ''()) (parallel-build? #t) @@ -169,50 +170,37 @@ (guix build utils)))) "Build SOURCE using LINUX, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (linux-module-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:source-directory ,source-directory - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:system ,system - #:target ,target - #:arch ,(system->arch (or target system)) - #:tests? ,tests? - #:outputs %outputs - #:make-flags ,make-flags - #:parallel-build? ,parallel-build? - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (linux-module-build #:name #$name + #:source #+source + #:source-directory #$source-directory + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$phases + #:system #$system + #:target #$target + #:arch #$(system->arch (or target system)) + #:tests? #$tests? + #:outputs #$(outputs->gexp outputs) + #:make-flags #$make-flags + #:parallel-build? #$parallel-build? + #:inputs #$(input-tuples->gexp 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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build - #:substitutable? substitutable?)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile + #:substitutable? substitutable?))) (define* (linux-module-build-cross - store name + name #:key - target native-drvs target-drvs + source target + build-inputs target-inputs host-inputs (guile #f) (outputs '("out")) (make-flags ''()) @@ -220,8 +208,7 @@ (search-paths '()) (native-search-paths '()) (tests? #f) - (phases '(@ (guix build linux-module-build-system) - %standard-phases)) + (phases '%standard-phases) (system (%current-system)) (substitutable? #t) (imported-modules @@ -229,70 +216,43 @@ (modules '((guix build linux-module-build-system) (guix build utils)))) (define builder - `(begin - (use-modules ,@modules) - (let () - (define %build-host-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name path) - `(,name . ,path))) - native-drvs)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) - (define %build-target-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name (? package? pkg) sub ...) - (let ((drv (package-cross-derivation store pkg - target system))) - `(,name . ,(apply derivation->output-path drv sub)))) - ((name path) - `(,name . ,path))) - target-drvs)) + (define %build-host-inputs + '#+(input-tuples->gexp build-inputs)) - (linux-module-build #:name ,name - #:source ,(match (assoc-ref native-drvs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:target ,target - #:arch ,(system->arch (or target system)) - #:outputs %outputs - #:make-flags ,make-flags - #:inputs %build-target-inputs - #:native-inputs %build-host-inputs - #:search-paths - ',(map search-path-specification->sexp - search-paths) - #:native-search-paths - ',(map - search-path-specification->sexp - native-search-paths) - #:phases ,phases - #:tests? ,tests?)))) + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-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))))) + (linux-module-build #:name #$name + #:source #+source + #:system #$system + #:target #$target + #:arch #$(system->arch (or target system)) + #:outputs #$(outputs->gexp outputs) + #:make-flags #$make-flags + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths + '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:native-search-paths + '#$(map + search-path-specification->sexp + native-search-paths) + #:phases #$phases + #:tests? #$tests?)))) - (build-expression->derivation store name builder - #:system system - #:inputs (append native-drvs target-drvs) - #:outputs outputs - #:modules imported-modules - #:guile-for-build guile-for-build - #:substitutable? substitutable?)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile + #:substitutable? substitutable?))) (define linux-module-build-system (build-system diff --git a/guix/build-system/maven.scm b/guix/build-system/maven.scm index 2dceefccc1..0af5922692 100644 --- a/guix/build-system/maven.scm +++ b/guix/build-system/maven.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +20,8 @@ (define-module (guix build-system maven) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -119,7 +121,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:jdk #:maven #:maven-plugins #:inputs #:native-inputs)) + '(#:target #:jdk #:maven #:maven-plugins #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -140,70 +142,56 @@ (build maven-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (maven-build store name inputs - #:key (guile #f) - (outputs '("out")) - (search-paths '()) - (out-of-source? #t) - (validate-runpath? #t) - (patch-shebangs? #t) - (strip-binaries? #t) - (exclude %default-exclude) - (local-packages '()) - (tests? #t) - (strip-flags ''("--strip-debug")) - (strip-directories ''("lib" "lib64" "libexec" - "bin" "sbin")) - (phases '(@ (guix build maven-build-system) - %standard-phases)) - (system (%current-system)) - (imported-modules %maven-build-system-modules) - (modules '((guix build maven-build-system) - (guix build maven pom) - (guix build utils)))) +(define* (maven-build name inputs + #:key + source (guile #f) + (outputs '("out")) + (search-paths '()) + (out-of-source? #t) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (exclude %default-exclude) + (local-packages '()) + (tests? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '%standard-phases) + (system (%current-system)) + (imported-modules %maven-build-system-modules) + (modules '((guix build maven-build-system) + (guix build maven pom) + (guix build utils)))) "Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE provides its own binaries." (define builder - `(begin - (use-modules ,@modules) - (maven-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:exclude (quote ,exclude) - #:local-packages (quote ,local-packages) - #:tests? ,tests? - #:out-of-source? ,out-of-source? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) - - (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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (maven-build #:source #+source + #:system #$system + #:outputs #$(outputs->gexp outputs) + #:inputs #$(input-tuples->gexp inputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$phases + #:exclude '#$exclude + #:local-packages '#$local-packages + #:tests? #$tests? + #:out-of-source? #$out-of-source? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories #$(sexp->gexp strip-directories))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define maven-build-system (build-system diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm index b68bcb80de..ba7441a3eb 100644 --- a/guix/build-system/meson.scm +++ b/guix/build-system/meson.scm @@ -1,6 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com> ;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,9 +20,10 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build-system meson) - #:use-module (guix store) + #:use-module (guix gexp) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -28,7 +31,8 @@ #:use-module (guix packages) #:use-module (ice-9 match) #:export (%meson-build-system-modules - meson-build-system)) + meson-build-system + make-cross-file)) ;; Commentary: ;; @@ -38,6 +42,68 @@ ;; ;; Code: +(define (make-machine-alist triplet) + "Make an association list describing what should go into +the ‘host_machine’ section of the cross file when cross-compiling +for TRIPLET." + `((system . ,(cond ((target-hurd? triplet) "gnu") + ((target-linux? triplet) "linux") + ((target-mingw? triplet) "windows") + (#t (error "meson: unknown operating system")))) + (cpu_family . ,(cond ((target-x86-32? triplet) "x86") + ((target-x86-64? triplet) "x86_64") + ((target-arm32? triplet) "arm") + ((target-aarch64? triplet) "aarch64") + ((target-powerpc? triplet) + (if (target-64bit? triplet) + "ppc64" + "ppc")) + (#t (error "meson: unknown architecture")))) + (cpu . ,(cond ((target-x86-32? triplet) ; i386, ..., i686 + (substring triplet 0 4)) + ((target-x86-64? triplet) "x86_64") + ((target-aarch64? triplet) "armv8-a") + ((target-arm32? triplet) "armv7") + ;; According to #mesonbuild on OFTC, there does not appear + ;; to be an official-ish list of CPU types recognised by + ;; Meson, the "cpu" field is not used by Meson itself and + ;; most software doesn't look at this field, except perhaps + ;; for selecting optimisations, so set it to something + ;; arbitrary. + (#t "strawberries"))) + (endian . ,(cond ((string-prefix? "powerpc64le-" triplet) "little") + ((string-prefix? "mips64el-" triplet) "little") + ((target-x86-32? triplet) "little") + ((target-x86-64? triplet) "little") + ;; At least in Guix. Aarch64 and 32-bit arm + ;; have a big-endian mode as well. + ((target-arm? triplet) "little") + (#t (error "meson: unknown architecture")))))) + +(define (make-binaries-alist triplet) + "Make an associatoin list describing what should go into +the ‘binaries’ section of the cross file when cross-compiling for +TRIPLET." + `((c . ,(cc-for-target triplet)) + (cpp . ,(cxx-for-target triplet)) + (pkgconfig . ,(pkg-config-for-target triplet)) + (objcopy . ,(string-append triplet "-objcopy")) + (ar . ,(string-append triplet "-ar")) + (ld . ,(string-append triplet "-ld")) + (strip . ,(string-append triplet "-strip")))) + +(define (make-cross-file triplet) + (computed-file "cross-file" + (with-imported-modules '((guix build meson-configuration)) + #~(begin + (use-modules (guix build meson-configuration)) + (call-with-output-file #$output + (lambda (port) + (write-section-header port "host_machine") + (write-assignments port '#$(make-machine-alist triplet)) + (write-section-header port "binaries") + (write-assignments port '#$(make-binaries-alist triplet)))))))) + (define %meson-build-system-modules ;; Build-side modules imported by default. `((guix build meson-build-system) @@ -55,7 +121,7 @@ "Return the default meson package." ;; Lazily resolve the binding to avoid a circular dependency. (let ((module (resolve-interface '(gnu packages build-tools)))) - (module-ref module 'meson-for-build))) + (module-ref module 'meson))) (define* (lower name #:key source inputs native-inputs outputs system target @@ -66,33 +132,44 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - `(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target)) - - (and (not target) ;; TODO: add support for cross-compilation. - (bag - (name name) - (system system) - (build-inputs `(("meson" ,meson) - ("ninja" ,ninja) - ,@native-inputs - ,@inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - (host-inputs (if source - `(("source" ,source)) - '())) - (outputs outputs) - (build meson-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) - -(define* (meson-build store name inputs - #:key (guile #f) + `(#:meson #:ninja #:inputs #:native-inputs #:outputs + ,@(if target + '() + '(#:target)))) + + (bag + (name name) + (system system) (target target) + (build-inputs `(("meson" ,meson) + ("ninja" ,ninja) + ,@native-inputs + ,@(if target '() inputs) + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(if target + (standard-cross-packages target 'host) + '()) + ,@(standard-packages))) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@(if target inputs '()))) + ;; Keep the standard inputs of 'gnu-buid-system'. + (target-inputs (if target + (standard-cross-packages target 'target) + '())) + (outputs outputs) + (build (if target meson-cross-build meson-build)) + (arguments (strip-keyword-arguments private-keywords arguments)))) + +(define* (meson-build name inputs + #:key + guile source (outputs '("out")) (configure-flags ''()) (search-paths '()) (build-type "debugoptimized") (tests? #t) - (test-target "test") + (test-options ''()) (glib-or-gtk? #f) (parallel-build? #t) (parallel-tests? #f) @@ -104,8 +181,7 @@ "bin" "sbin")) (elf-directories ''("lib" "lib64" "libexec" "bin" "sbin")) - (phases '(@ (guix build meson-build-system) - %standard-phases)) + (phases '%standard-phases) (system (%current-system)) (imported-modules %meson-build-system-modules) (modules '((guix build meson-build-system) @@ -114,76 +190,154 @@ disallowed-references) "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE has a 'meson.build' file." + (define builder + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define build-phases + #$(let ((phases (if (pair? phases) (sexp->gexp phases) phases))) + (if glib-or-gtk? + phases + #~(modify-phases #$phases + (delete 'glib-or-gtk-compile-schemas) + (delete 'glib-or-gtk-wrap))))) + + #$(with-build-variables inputs outputs + #~(meson-build #:source #+source + #:system #$system + #:outputs %outputs + #:inputs %build-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases build-phases + #:configure-flags + #$(if (pair? configure-flags) + (sexp->gexp configure-flags) + configure-flags) + #:build-type #$build-type + #:tests? #$tests? + #:test-options #$(sexp->gexp test-options) + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories #$(sexp->gexp strip-directories) + #:elf-directories #$(sexp->gexp elf-directories)))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target #f + #:graft? #f + #:substitutable? substitutable? + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) - ;; TODO: Copied from build-system/gnu, factorize this! - (define canonicalize-reference - (match-lambda - ((? package? p) - (derivation->output-path (package-derivation store p system - #:graft? #f))) - (((? package? p) output) - (derivation->output-path (package-derivation store p system - #:graft? #f) - output)) - ((? string? output) - output))) +(define* (meson-cross-build name + #:key + target + build-inputs host-inputs target-inputs + guile source + (outputs '("out")) + (configure-flags ''()) + (search-paths '()) + (native-search-paths '()) + (build-type "debugoptimized") + (tests? #f) + (test-options ''()) + (glib-or-gtk? #f) + (parallel-build? #t) + (parallel-tests? #f) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (elf-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + ;; See 'gnu-cross-build' for why this needs to be + ;; disabled when cross-compiling. + (make-dynamic-linker-cache? #f) + (phases '%standard-phases) + (system (%current-system)) + (imported-modules %meson-build-system-modules) + (modules '((guix build meson-build-system) + (guix build utils))) + allowed-references + disallowed-references) + "Cross-build SOURCE for TARGET using MESON, and with INPUTS, assuming that +SOURCE has a 'meson.build' file." + (define cross-file + (make-cross-file target)) + (define inputs + (if (null? target-inputs) + (input-tuples->gexp host-inputs) + #~(append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs)))) (define builder - `(let ((build-phases (if ,glib-or-gtk? - ,phases - (modify-phases ,phases - (delete 'glib-or-gtk-compile-schemas) - (delete 'glib-or-gtk-wrap))))) - (use-modules ,@modules) - (meson-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases build-phases - #:configure-flags ,configure-flags - #:build-type ,build-type - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories - #:elf-directories ,elf-directories))) - - (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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build - #:allowed-references - (and allowed-references - (map canonicalize-reference - allowed-references)) - #:disallowed-references - (and disallowed-references - (map canonicalize-reference - disallowed-references)))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define build-phases + #$(let ((phases (if (pair? phases) (sexp->gexp phases) phases))) + (if glib-or-gtk? + phases + #~(modify-phases #$phases + (delete 'glib-or-gtk-compile-schemas) + (delete 'glib-or-gtk-wrap))))) + + ;; Do not use 'with-build-variables', as there should be + ;; no reason to use %build-inputs and friends. + (meson-build #:source #+source + #:system #$system + #:build #$(nix-system->gnu-triplet system) + #:target #$target + #:outputs #$(outputs->gexp outputs) + #:inputs #$inputs + #:native-inputs #+(input-tuples->gexp build-inputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:native-search-paths '#$(sexp->gexp + (map search-path-specification->sexp + native-search-paths)) + #:phases build-phases + #:make-dynamic-linker-cache? #$make-dynamic-linker-cache? + #:configure-flags `("--cross-file" #+cross-file + ,@#$(if (pair? configure-flags) + (sexp->gexp configure-flags) + configure-flags)) + #:build-type #$build-type + #:tests? #$tests? + #:test-options #$(sexp->gexp test-options) + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$(sexp->gexp strip-flags) + #:strip-directories #$(sexp->gexp strip-directories) + #:elf-directories #$(sexp->gexp elf-directories))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:target target + #:graft? #f + #:substitutable? substitutable? + #:allowed-references allowed-references + #:disallowed-references disallowed-references + #:guile-for-build guile))) (define meson-build-system (build-system diff --git a/guix/build-system/minify.scm b/guix/build-system/minify.scm index 9d53760685..7d4745ab32 100644 --- a/guix/build-system/minify.scm +++ b/guix/build-system/minify.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +21,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -54,7 +56,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:inputs #:native-inputs)) + '(#:target #:inputs #:native-inputs)) (bag (name name) @@ -70,11 +72,11 @@ (build minify-build) (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (minify-build store name inputs +(define* (minify-build name inputs #:key + source (javascript-files #f) - (phases '(@ (guix build minify-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (system (%current-system)) search-paths @@ -84,38 +86,24 @@ (guix build utils)))) "Build SOURCE with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (minify-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:javascript-files ,javascript-files - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (minify-build #:name #$name + #:source #+source + #:javascript-files #$javascript-files + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp 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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define minify-build-system (build-system diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm index 98f63f87ef..735f8dd06e 100644 --- a/guix/build-system/node.scm +++ b/guix/build-system/node.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org> ;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,9 +19,11 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build-system node) + #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -48,7 +51,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:node #:inputs #:native-inputs)) + '(#:target #:node #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -67,12 +70,13 @@ (build node-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (node-build store name inputs +(define* (node-build name inputs #:key + source + (npm-flags ''()) (test-target "test") (tests? #t) - (phases '(@ (guix build node-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -82,38 +86,27 @@ (guix build utils)))) "Build SOURCE using NODE and INPUTS." (define builder - `(begin - (use-modules ,@modules) - (node-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) source) - (source source)) - #:system ,system - #:test-target ,test-target - #:tests? ,tests? - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (node-build #:name #$name + #:source #+source + #:system #$system + #:npm-flags #$npm-flags + #:test-target #$test-target + #:tests? #$tests? + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp inputs))))) - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system #:graft? #f)) - (#f - (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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define node-build-system (build-system diff --git a/guix/build-system/ocaml.scm b/guix/build-system/ocaml.scm index 5513216c25..e7d6d96f0e 100644 --- a/guix/build-system/ocaml.scm +++ b/guix/build-system/ocaml.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +20,7 @@ (define-module (guix build-system ocaml) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -206,7 +207,7 @@ pre-defined variants." #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:ocaml #:findlib #:inputs #:native-inputs)) + '(#:target #:ocaml #:findlib #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -226,8 +227,9 @@ pre-defined variants." (build ocaml-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (ocaml-build store name inputs - #:key (guile #f) +(define* (ocaml-build name inputs + #:key + guile source (outputs '("out")) (configure-flags ''()) (search-paths '()) (make-flags ''()) @@ -253,51 +255,35 @@ pre-defined variants." "Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE provides a 'setup.ml' file as its build system." (define builder - `(begin - (use-modules ,@modules) - (ocaml-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:configure-flags ,configure-flags - #:test-flags ,test-flags - #:make-flags ,make-flags - #:build-flags ,build-flags - #:out-of-source? ,out-of-source? - #:use-make? ,use-make? - #:tests? ,tests? - #:test-target ,test-target - #:install-target ,install-target - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) - - (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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@modules) + (ocaml-build #:source #$source + #:system #$system + #:outputs #$(outputs->gexp outputs) + #:inputs #$(input-tuples->gexp inputs) + #:search-paths '#$(map search-path-specification->sexp + search-paths) + #:phases #$phases + #:configure-flags #$configure-flags + #:test-flags #$test-flags + #:make-flags #$make-flags + #:build-flags #$build-flags + #:out-of-source? #$out-of-source? + #:use-make? #$use-make? + #:tests? #$tests? + #:test-target #$test-target + #:install-target #$install-target + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories)))) + + (gexp->derivation name builder + #:system system + #:target #f + #:guile-for-build guile)) (define ocaml-build-system (build-system diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index 06af1dd20e..db0a916fb2 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,8 @@ (define-module (guix build-system perl) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) @@ -57,7 +59,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:perl #:inputs #:native-inputs)) + '(#:target #:perl #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -76,8 +78,8 @@ (build perl-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (perl-build store name inputs - #:key +(define* (perl-build name inputs + #:key source (search-paths '()) (tests? #t) (parallel-build? #t) @@ -95,46 +97,37 @@ (guix build utils)))) "Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE provides a `Makefile.PL' file as its build system." - (define builder - `(begin - (use-modules ,@modules) - (perl-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:make-maker? ,make-maker? - #:make-maker-flags ,make-maker-flags - #:module-build-flags ,module-build-flags - #:phases ,phases - #:system ,system - #:test-target "test" - #:tests? ,tests? - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:outputs %outputs - #:inputs %build-inputs))) + (define build + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) - (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))))) + #$(with-build-variables inputs outputs + #~(perl-build #:name #$name + #:source #+source + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:make-maker? #$make-maker? + #:make-maker-flags #$make-maker-flags + #:module-build-flags #$(sexp->gexp module-build-flags) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:system #$system + #:test-target "test" + #:tests? #$tests? + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:outputs %outputs + #:inputs %build-inputs))))) - (build-expression->derivation store name builder - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name build + #:system system + #:target #f + #:guile-for-build guile))) (define perl-build-system (build-system diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index 80895162f8..efade6f74b 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -1,7 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> +;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,9 +20,13 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build-system python) + #:use-module ((gnu packages) #:select (search-auxiliary-file)) + #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix memoization) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) @@ -70,6 +75,10 @@ extension, such as '.tar.gz'." (let ((python (resolve-interface '(gnu packages python)))) (module-ref python 'python-2))) +(define sanity-check.py + ;; The script used to validate the installation of a Python package. + (search-auxiliary-file "python/sanity-check.py")) + (define* (package-with-explicit-python python old-prefix new-prefix #:key variant-property) "Return a procedure of one argument, P. The procedure creates a package with @@ -140,7 +149,7 @@ pre-defined variants." #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:python #:inputs #:native-inputs)) + '(#:target #:python #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -154,19 +163,19 @@ pre-defined variants." ;; Keep the standard inputs of 'gnu-build-system'. ,@(standard-packages))) (build-inputs `(("python" ,python) + ("sanity-check.py" ,(local-file sanity-check.py)) ,@native-inputs)) (outputs outputs) (build python-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (python-build store name inputs - #:key +(define* (python-build name inputs + #:key source (tests? #t) (test-target "test") (use-setuptools? #t) (configure-flags ''()) - (phases '(@ (guix build python-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -176,43 +185,35 @@ pre-defined variants." (guix build utils)))) "Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE provides a 'setup.py' file as its build system." - (define builder - `(begin - (use-modules ,@modules) - (python-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? - #:use-setuptools? ,use-setuptools? - #: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 build + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + #$(with-build-variables inputs outputs + #~(python-build #:name #$name + #:source #+source + #:configure-flags #$configure-flags + #:use-setuptools? #$use-setuptools? + #:system #$system + #:test-target #$test-target + #:tests? #$tests? + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:outputs %outputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs %build-inputs))))) + + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name build + #:system system + #:target #f + #:guile-for-build guile))) (define python-build-system (build-system diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm index e1368db1d9..003a065aa6 100644 --- a/guix/build-system/qt.scm +++ b/guix/build-system/qt.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com> @@ -23,9 +23,10 @@ (define-module (guix build-system qt) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module ((guix build qt-utils) #:select (%qt-wrap-excluded-inputs)) - #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system cmake) @@ -75,7 +76,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - `(#:source #:cmake #:inputs #:native-inputs #:outputs + `(#:cmake #:inputs #:native-inputs #:outputs ,@(if target '() '(#:target)))) (bag @@ -109,8 +110,9 @@ (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (qt-build store name inputs - #:key (guile #f) +(define* (qt-build name inputs + #:key + source (guile #f) (outputs '("out")) (configure-flags ''()) (search-paths '()) (make-flags ''()) @@ -125,8 +127,7 @@ (strip-flags ''("--strip-debug")) (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) - (phases '(@ (guix build qt-build-system) - %standard-phases)) + (phases '%standard-phases) (qt-wrap-excluded-outputs ''()) (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs) (system (%current-system)) @@ -136,61 +137,50 @@ "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its build system." (define builder - `(begin - (use-modules ,@modules) - (qt-build #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:outputs %outputs - #:inputs %build-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs - #:qt-wrap-excluded-inputs ,qt-wrap-excluded-inputs - #:configure-flags ,configure-flags - #:make-flags ,make-flags - #:out-of-source? ,out-of-source? - #:build-type ,build-type - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (qt-build #:source #+source + #:system #$system + #:outputs #$(outputs->gexp outputs) + #:inputs #$(input-tuples->gexp inputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs + #:qt-wrap-excluded-inputs #$qt-wrap-excluded-inputs + #:configure-flags #$configure-flags + #:make-flags #$make-flags + #:out-of-source? #$out-of-source? + #:build-type #$build-type + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories)))) - (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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) ;;; ;;; Cross-compilation. ;;; -(define* (qt-cross-build store name +(define* (qt-cross-build name #:key - target native-drvs target-drvs + source target + build-inputs target-inputs host-inputs (guile #f) (outputs '("out")) (configure-flags ''()) @@ -199,7 +189,7 @@ provides a 'CMakeLists.txt' file as its build system." (make-flags ''()) (out-of-source? #t) (build-type "RelWithDebInfo") - (tests? #f) ; nothing can be done + (tests? #f) ; nothing can be done (test-target "test") (parallel-build? #t) (parallel-tests? #f) (validate-runpath? #t) @@ -209,8 +199,7 @@ provides a 'CMakeLists.txt' file as its build system." "--enable-deterministic-archives")) (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) - (phases '(@ (guix build qt-build-system) - %standard-phases)) + (phases '%standard-phases) (system (%current-system)) (build (nix-system->gnu-triplet system)) (imported-modules %qt-build-system-modules) @@ -220,77 +209,53 @@ provides a 'CMakeLists.txt' file as its build system." with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its build system." (define builder - `(begin - (use-modules ,@modules) - (let () - (define %build-host-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name path) - `(,name . ,path))) - native-drvs)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + (define %build-host-inputs + #+(input-tuples->gexp build-inputs)) - (define %build-target-inputs - ',(map (match-lambda - ((name (? derivation? drv) sub ...) - `(,name . ,(apply derivation->output-path drv sub))) - ((name (? package? pkg) sub ...) - (let ((drv (package-cross-derivation store pkg - target system))) - `(,name . ,(apply derivation->output-path drv sub)))) - ((name path) - `(,name . ,path))) - target-drvs)) + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) + #+(input-tuples->gexp target-inputs))) - (qt-build #:source ,(match (assoc-ref native-drvs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:build ,build - #:target ,target - #:outputs %outputs - #:inputs %build-target-inputs - #:native-inputs %build-host-inputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:native-search-paths ',(map - search-path-specification->sexp - native-search-paths) - #:phases ,phases - #:configure-flags ,configure-flags - #:make-flags ,make-flags - #:out-of-source? ,out-of-source? - #:build-type ,build-type - #:tests? ,tests? - #:test-target ,test-target - #:parallel-build? ,parallel-build? - #:parallel-tests? ,parallel-tests? - #:validate-runpath? ,validate-runpath? - #:patch-shebangs? ,patch-shebangs? - #:strip-binaries? ,strip-binaries? - #:strip-flags ,strip-flags - #:strip-directories ,strip-directories)))) + (define %outputs + #$(outputs->gexp outputs)) - (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))))) + (qt-build #:source #+source + #:system #$system + #:build #$build + #:target #$target + #:outputs %outputs + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:native-search-paths '#$(map + search-path-specification->sexp + native-search-paths) + #:phases #$phases + #:configure-flags #$configure-flags + #:make-flags #$make-flags + #:out-of-source? #$out-of-source? + #:build-type #$build-type + #:tests? #$tests? + #:test-target #$test-target + #:parallel-build? #$parallel-build? + #:parallel-tests? #$parallel-tests? + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories)))) - (build-expression->derivation store name builder - #:system system - #:inputs (append native-drvs target-drvs) - #:outputs outputs - #:modules imported-modules - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define qt-build-system (build-system diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm index 96d37d5ea6..2c82390ba6 100644 --- a/guix/build-system/r.scm +++ b/guix/build-system/r.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +21,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -82,7 +84,7 @@ release corresponding to NAME and VERSION." #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:r #:inputs #:native-inputs)) + '(#:target #:r #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -101,13 +103,13 @@ release corresponding to NAME and VERSION." (build r-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (r-build store name inputs +(define* (r-build name inputs #:key + source (tests? #t) (test-target "tests") (configure-flags ''()) - (phases '(@ (guix build r-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -118,42 +120,28 @@ release corresponding to NAME and VERSION." (guix build utils)))) "Build SOURCE with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (r-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 - #:tests? ,tests? - #:test-target ,test-target - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (r-build #:name #$name + #:source #+source + #:configure-flags #$configure-flags + #:system #$system + #:tests? #$tests? + #:test-target #$test-target + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp 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 - #:substitutable? substitutable?)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile + #:substitutable? substitutable?))) (define r-build-system (build-system diff --git a/guix/build-system/rakudo.scm b/guix/build-system/rakudo.scm index a02e2bad3a..05a4d9c2ad 100644 --- a/guix/build-system/rakudo.scm +++ b/guix/build-system/rakudo.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +20,8 @@ (define-module (guix build-system rakudo) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -71,7 +73,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:rakudo #:prove6 #:zef #:inputs #:native-inputs)) + '(#:target #:rakudo #:prove6 #:zef #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -96,12 +98,12 @@ (build rakudo-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (rakudo-build store name inputs +(define* (rakudo-build name inputs #:key + source (search-paths '()) (tests? #t) - (phases '(@ (guix build rakudo-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (system (%current-system)) (guile #f) @@ -112,39 +114,25 @@ (guix build utils)))) "Build SOURCE using PERL6, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (rakudo-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:phases ,phases - #:system ,system - #:tests? ,tests? - #:outputs %outputs - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (rakudo-build #:name #$name + #:source #+source + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:phases #$phases + #:system #$system + #:tests? #$tests? + #:outputs #$(outputs->gexp outputs) + #:inputs #$(input-tuples->gexp 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 - #:system system - #:inputs inputs - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define rakudo-build-system (build-system diff --git a/guix/build-system/renpy.scm b/guix/build-system/renpy.scm index 5ed59bf5a5..f1070951ee 100644 --- a/guix/build-system/renpy.scm +++ b/guix/build-system/renpy.scm @@ -1,4 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Leo Prikler <leo.prikler@student.tugraz.at> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Liliana Marie Prikler <liliana.prikler@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -21,7 +23,8 @@ #:use-module (guix utils) #:use-module (guix memoization) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -53,7 +56,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:renpy #:inputs #:native-inputs)) + '(#:target #:renpy #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -72,57 +75,43 @@ (build renpy-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (renpy-build store name inputs - #:key - (phases '(@ (guix build renpy-build-system) - %standard-phases)) - (configure-flags ''()) - (outputs '("out")) - (output "out") - (game "game") - (search-paths '()) - (system (%current-system)) - (guile #f) - (imported-modules %renpy-build-system-modules) - (modules '((guix build renpy-build-system) - (guix build utils)))) +(define* (renpy-build name inputs + #:key + source + (phases '%standard-phases) + (configure-flags ''()) + (outputs '("out")) + (output "out") + (game "game") + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %renpy-build-system-modules) + (modules '((guix build renpy-build-system) + (guix build utils)))) "Build SOURCE using RENPY, and with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (renpy-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 - #:phases ,phases - #:outputs %outputs - #:output ,output - #:game ,game - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + (renpy-build #:name #$name + #:source #+source + #:configure-flags #$configure-flags + #:system #$system + #:phases #$phases + #:outputs #$(outputs->gexp outputs) + #:output #$output + #:game #$game + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs #$(input-tuples->gexp 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)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) (define renpy-build-system (build-system diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm index 8142e8551a..342daf7978 100644 --- a/guix/build-system/ruby.scm +++ b/guix/build-system/ruby.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson <davet@gnu.org> -;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,8 @@ (define-module (guix build-system ruby) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) @@ -54,7 +56,7 @@ NAME and VERSION." #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:ruby #:inputs #:native-inputs)) + '(#:target #:ruby #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -73,13 +75,12 @@ NAME and VERSION." (build ruby-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (ruby-build store name inputs - #:key +(define* (ruby-build name inputs + #:key source (gem-flags ''()) (test-target "test") (tests? #t) - (phases '(@ (guix build ruby-build-system) - %standard-phases)) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -88,42 +89,33 @@ NAME and VERSION." (modules '((guix build ruby-build-system) (guix build utils)))) "Build SOURCE using RUBY and INPUTS." - (define builder - `(begin - (use-modules ,@modules) - (ruby-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:system ,system - #:gem-flags ,gem-flags - #:test-target ,test-target - #:tests? ,tests? - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (define build + #~(begin + (use-modules #$@(sexp->gexp modules)) - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system #:graft? #f)) - (#f - (let* ((distro (resolve-interface '(gnu packages commencement))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system #:graft? #f))))) + #$(with-build-variables inputs outputs + #~(ruby-build #:name #$name + #:source #+source + #:system #$system + #:gem-flags #$gem-flags + #:test-target #$test-target + #:tests? #$tests? + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:outputs %outputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs %build-inputs)))) - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name build + #:system system + #:target #f + #:modules imported-modules + #:guile-for-build guile))) (define ruby-build-system (build-system diff --git a/guix/build-system/scons.scm b/guix/build-system/scons.scm index aad455c419..74901b3478 100644 --- a/guix/build-system/scons.scm +++ b/guix/build-system/scons.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +20,8 @@ (define-module (guix build-system scons) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -53,7 +55,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:scons #:inputs #:native-inputs)) + '(#:target #:scons #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -72,15 +74,15 @@ (build scons-build) (arguments (strip-keyword-arguments private-keywords arguments))))) -(define* (scons-build store name inputs +(define* (scons-build name inputs #:key + (source #f) (tests? #t) (scons-flags ''()) - (build-targets ''()) + (build-targets #~'()) (test-target "test") - (install-targets ''("install")) - (phases '(@ (guix build scons-build-system) - %standard-phases)) + (install-targets #~'("install")) + (phases '%standard-phases) (outputs '("out")) (search-paths '()) (system (%current-system)) @@ -91,43 +93,33 @@ "Build SOURCE using SCons, and with INPUTS. This assumes that SOURCE provides a 'SConstruct' file as its build system." (define builder - `(begin - (use-modules ,@modules) - (scons-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:scons-flags ,scons-flags - #:system ,system - #:build-targets ,build-targets - #:test-target ,test-target - #:tests? ,tests? - #:install-targets ,install-targets - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) - (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))))) + #$(with-build-variables inputs outputs + #~(scons-build #:name #$name + #:source #+source + #:scons-flags #$(sexp->gexp scons-flags) + #:system #$system + #:build-targets #$build-targets + #:test-target #$test-target + #:tests? #$tests? + #:install-targets #$install-targets + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:outputs %outputs + #:inputs %build-inputs + #:search-paths + '#$(sexp->gexp + (map search-path-specification->sexp + search-paths))))))) - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (gexp->derivation name builder + #:system system + #:target #f + #:guile-for-build guile)) (define scons-build-system (build-system diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm index 8bbca0ccb7..09907c67d8 100644 --- a/guix/build-system/texlive.scm +++ b/guix/build-system/texlive.scm @@ -1,5 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Thiago Jung Bauermann <bauermann@kolabnow.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +22,8 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) - #:use-module (guix derivations) + #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) @@ -42,8 +45,8 @@ ;; These variables specify the SVN tag and the matching SVN revision. They ;; are taken from https://www.tug.org/svn/texlive/tags/ -(define %texlive-tag "texlive-2019.3") -(define %texlive-revision 51265) +(define %texlive-tag "texlive-2021.3") +(define %texlive-revision 59745) (define (texlive-origin name version locations hash) "Return an <origin> object for a TeX Live package consisting of multiple @@ -59,13 +62,17 @@ name for the checkout directory." (file-name (string-append name "-" version "-checkout")) (sha256 hash))) -(define (texlive-ref component id) +(define* (texlive-ref component #:optional id) "Return a <svn-reference> object for the package ID, which is part of the -given Texlive COMPONENT." +given Texlive COMPONENT. If ID is not provided, COMPONENT is used as the top +level package ID." (svn-reference (url (string-append "svn://www.tug.org/texlive/tags/" %texlive-tag "/Master/texmf-dist/" - "source/" component "/" id)) + "source/" component + (if id + (string-append "/" id) + ""))) (revision %texlive-revision))) (define %texlive-build-system-modules @@ -96,7 +103,7 @@ given Texlive COMPONENT." #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:inputs #:native-inputs + '(#:target #:inputs #:native-inputs #:texlive-latex-base #:texlive-bin)) (bag @@ -110,18 +117,29 @@ given Texlive COMPONENT." ;; Keep the standard inputs of 'gnu-build-system'. ,@(standard-packages))) (build-inputs `(("texlive-bin" ,texlive-bin) - ("texlive-latex-base" ,texlive-latex-base) + ,@(if texlive-latex-base + `(("texlive-latex-base" ,texlive-latex-base)) + '()) ,@native-inputs)) (outputs outputs) (build texlive-build) (arguments (strip-keyword-arguments private-keywords arguments)))) -(define* (texlive-build store name inputs +(define* (texlive-build name inputs #:key + source (tests? #f) tex-directory (build-targets #f) - (tex-format "luatex") + (tex-engine #f) + + ;; FIXME: This would normally default to "luatex" but + ;; LuaTeX has a bug where sometimes it corrupts the + ;; heap and aborts. This causes the build of texlive + ;; packages to fail at random. The problem is being + ;; tracked at <https://issues.guix.gnu.org/48064>. + (tex-format "pdftex") + (phases '(@ (guix build texlive-build-system) %standard-phases)) (outputs '("out")) @@ -135,43 +153,34 @@ given Texlive COMPONENT." (guix build utils)))) "Build SOURCE with INPUTS." (define builder - `(begin - (use-modules ,@modules) - (texlive-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:tex-directory ,tex-directory - #:build-targets ,build-targets - #:tex-format ,tex-format - #:system ,system - #: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 - #:substitutable? substitutable?)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + #$(with-build-variables inputs outputs + #~(texlive-build #:name #$name + #:source #+source + #:tex-directory #$tex-directory + #:build-targets #$build-targets + #:tex-engine #$(if tex-engine + tex-engine + tex-format) + #:tex-format #$tex-format + #:system #$system + #:tests? #$tests? + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:outputs %outputs + #:inputs %build-inputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths))))))) + + (gexp->derivation name builder + #:system system + #:target #f + #:substitutable? substitutable?)) (define texlive-build-system (build-system diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm index b50ef7cd92..378ae481b9 100644 --- a/guix/build-system/trivial.scm +++ b/guix/build-system/trivial.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,24 +19,16 @@ (define-module (guix build-system trivial) #:use-module (guix store) #:use-module (guix utils) - #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix build-system) #:use-module (ice-9 match) #:export (trivial-build-system)) -(define (guile-for-build store guile system) - (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))))) - (define* (lower name #:key source inputs native-inputs outputs system target - guile builder modules allowed-references) + guile builder (modules '()) allowed-references) "Return a bag for NAME." (bag (name name) @@ -54,65 +46,50 @@ #:modules ,modules #:allowed-references ,allowed-references)))) -(define* (trivial-build store name inputs +(define* (trivial-build name inputs #:key - outputs guile system builder (modules '()) + outputs guile + system builder (modules '()) search-paths allowed-references) "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is ignored." - (define canonicalize-reference - (match-lambda - ((? package? p) - (derivation->output-path (package-derivation store p system - #:graft? #f))) - (((? package? p) output) - (derivation->output-path (package-derivation store p system - #:graft? #f) - output)) - ((? string? output) - output))) - - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:outputs outputs - #:modules modules - #:allowed-references - (and allowed-references - (map canonicalize-reference - allowed-references)) - #:guile-for-build - (guile-for-build store guile system))) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f)) + (builder -> (if (pair? builder) + (sexp->gexp builder) + builder))) + (gexp->derivation name (with-build-variables inputs outputs builder) + #:system system + #:target #f + #:graft? #f + #:modules modules + #:allowed-references allowed-references + #:guile-for-build guile))) -(define* (trivial-cross-build store name +(define* (trivial-cross-build name #:key - target native-drvs target-drvs + target + source build-inputs target-inputs host-inputs outputs guile system builder (modules '()) search-paths native-search-paths allowed-references) "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is ignored." - (define canonicalize-reference - (match-lambda - ((? package? p) - (derivation->output-path (package-cross-derivation store p system))) - (((? package? p) output) - (derivation->output-path (package-cross-derivation store p system) - output)) - ((? string? output) - output))) - - (build-expression->derivation store name builder - #:inputs (append native-drvs target-drvs) - #:system system - #:outputs outputs - #:modules modules - #:allowed-references - (and allowed-references - (map canonicalize-reference - allowed-references)) - #:guile-for-build - (guile-for-build store guile system))) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f)) + (builder -> (if (pair? builder) + (sexp->gexp builder) + builder))) + (gexp->derivation name (with-build-variables + (append build-inputs target-inputs host-inputs) + outputs + builder) + #:system system + #:target target + #:graft? #f + #:modules modules + #:allowed-references allowed-references + #:guile-for-build guile))) (define trivial-build-system (build-system diff --git a/guix/build-system/waf.scm b/guix/build-system/waf.scm index 044d2a0829..e8cd5520b8 100644 --- a/guix/build-system/waf.scm +++ b/guix/build-system/waf.scm @@ -19,6 +19,8 @@ (define-module (guix build-system waf) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) @@ -52,7 +54,7 @@ #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:python #:inputs #:native-inputs)) + '(#:target #:python #:inputs #:native-inputs)) (and (not target) ;XXX: no cross-compilation (bag @@ -71,58 +73,46 @@ (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 %waf-build-system-modules) - (modules '((guix build waf-build-system) - (guix build utils)))) +(define* (waf-build name inputs + #:key source + (tests? #t) + (test-target "check") + (configure-flags #~'()) + (phases '%standard-phases) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %waf-build-system-modules) + (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 build + #~(begin + (use-modules #$@(sexp->gexp modules)) - (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))))) + #$(with-build-variables inputs outputs + #~(waf-build #:name #$name + #:source #+source + #:configure-flags #$configure-flags + #:system #$system + #:test-target #$test-target + #:tests? #$tests? + #:phases #$phases + #:outputs %outputs + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:inputs %build-inputs)))) - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name build + #:system system + #:target #f + #:modules imported-modules + #:guile-for-build guile))) (define waf-build-system (build-system |