diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | doc/guix.texi | 64 | ||||
| -rw-r--r-- | guix/build-system/copy.scm | 143 | ||||
| -rw-r--r-- | guix/build/copy-build-system.scm | 165 |
4 files changed, 374 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index c6a2e6cf6c..e18c17d8b3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -122,6 +122,7 @@ MODULES = \ guix/build-system/meson.scm \ guix/build-system/minify.scm \ guix/build-system/asdf.scm \ + guix/build-system/copy.scm \ guix/build-system/glib-or-gtk.scm \ guix/build-system/gnu.scm \ guix/build-system/guile.scm \ @@ -169,6 +170,7 @@ MODULES = \ guix/build/go-build-system.scm \ guix/build/asdf-build-system.scm \ guix/build/bzr.scm \ + guix/build/copy-build-system.scm \ guix/build/git.scm \ guix/build/hg.scm \ guix/build/glib-or-gtk-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 2c95dbfe63..58a4aa65ac 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6154,6 +6154,70 @@ parameters available to cargo. It will also remove an included if they are defined by the crate. @end defvr + +@defvr {Scheme Variable} copy-build-system +@cindex (copy build system) +This variable is exported by @code{(guix build-system copy)}. It +supports builds of simple packages that don't require much compiling, +mostly just moving files around. + +It adds much of the @code{gnu-build-system} packages to the set of +inputs. Because of this, the @code{copy-build-system} does not require +all the boilerplate code often needed for the +@code{trivial-build-system}. + +To further simplify the file installation process, an +@code{#:install-plan} argument is exposed to let the packager specify +which files go where. +The install plan is a list of @code{(SOURCE TARGET [FILTERS])}. +@code{FILTERS} are optional. + +@itemize +@item When @code{SOURCE} matches a file or directory without trailing slash, install it to @code{TARGET}. + @itemize + @item If @code{TARGET} has a trailing slash, install @code{SOURCE} basename beneath @code{TARGET}. + @item Otherwise install @code{SOURCE} as @code{TARGET}. + @end itemize + +@item When @code{SOURCE} is a directory with a trailing slash, or when @code{FILTERS} are used, + the trailing slash of @code{TARGET} is implied with the same meaning + as above. + @itemize + @item Without @code{FILTERS}, install the full @code{SOURCE} @emph{content} to @code{TARGET}. + @item With @code{FILTERS} among @code{#:include}, @code{#:include-regexp}, @code{exclude}, + @code{#:exclude-regexp}, only select files are installed depending on + the filters. Each filters is specified by a list of strings. + @itemize + @item With @code{#:include}, install all the files which path suffix exactly matches + one of the elements in the given list. + @item With @code{#:include-regexp}, install all the files which subpaths match the + regular expressions in the given list. + @item The @code{#:exclude} and @code{#:exclude-regexp} filters + are the complement of their inclusion counterpart. Without @code{#:include} flags, + install all files but those matching the exclusion filters. + If both inclusions and exclusions are specified, the exclusions are done + on top of the inclusions. + @end itemize + @end itemize + In all cases, the paths relative to @code{SOURCE} are preserved within + @code{TARGET}. +@end itemize + +Examples: + +@itemize +@item @code{("foo/bar" "share/my-app/")}: Install @code{bar} to @code{share/my-app/bar}. +@item @code{("foo/bar" "share/my-app/baz")}: Install @code{bar} to @code{share/my-app/baz}. +@item @code{("foo/" "share/my-app")}: Install the content of @code{foo} inside @code{share/my-app}, + e.g. install @code{foo/sub/file} to @code{share/my-app/sub/file}. +@item @code{("foo/" "share/my-app" #:include ("sub/file"))}: Install only @code{foo/sub/file} to +@code{share/my-app/sub/file}. +@item @code{("foo/sub" "share/my-app" #:include ("file"))}: Install @code{foo/sub/file} to +@code{share/my-app/file}. +@end itemize +@end defvr + + @cindex Clojure (programming language) @cindex simple Clojure build system @defvr {Scheme Variable} clojure-build-system diff --git a/guix/build-system/copy.scm b/guix/build-system/copy.scm new file mode 100644 index 0000000000..5fd0da4493 --- /dev/null +++ b/guix/build-system/copy.scm @@ -0,0 +1,143 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix build-system copy) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (%copy-build-system-modules + default-glibc + lower + copy-build + copy-build-system)) + +;; Commentary: +;; +;; Standard build procedure for simple packages that don't require much +;; compilation, mostly just copying files around. This is implemented as an +;; extension of `gnu-build-system'. +;; +;; Code: + +(define %copy-build-system-modules + ;; Build-side modules imported by default. + `((guix build copy-build-system) + ,@%gnu-build-system-modules)) + +(define (default-glibc) + "Return the default glibc package." + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages base)))) + (module-ref module 'glibc))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (glibc (default-glibc)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME from the given arguments." + (define private-keywords + '(#:source #:target #:inputs #:native-inputs)) + + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (build-inputs native-inputs) + (outputs outputs) + (build copy-build) + (arguments (strip-keyword-arguments private-keywords arguments)))) + +(define* (copy-build store name inputs + #:key (guile #f) + (outputs '("out")) + (install-plan ''(("." (".") "./"))) + (search-paths '()) + (out-of-source? #t) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build copy-build-system) + %standard-phases)) + (system (%current-system)) + (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))) + + (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)) + +(define copy-build-system + (build-system + (name 'copy) + (description "The standard copy build system") + (lower lower))) + +;;; copy.scm ends here diff --git a/guix/build/copy-build-system.scm b/guix/build/copy-build-system.scm new file mode 100644 index 0000000000..6d9dc8f93b --- /dev/null +++ b/guix/build/copy-build-system.scm @@ -0,0 +1,165 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix build copy-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 ftw) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + copy-build)) + +;; Commentary: +;; +;; System for building packages that don't require much compilation, mostly +;; only to copy files around. +;; +;; Code: + +(define* (install #:key install-plan outputs #:allow-other-keys) + "Copy files from the \"source\" build input to the \"out\" output according to INSTALL-PLAN. + +An install plan is a list of plans in the form: + + (SOURCE TARGET [FILTERS]) + +In the above, FILTERS are optional. + +- When SOURCE matches a file or directory without trailing slash, install it to + TARGET. + - If TARGET has a trailing slash, install SOURCE basename beneath TARGET. + - Otherwise install SOURCE as TARGET. + +- When SOURCE is a directory with a trailing slash, or when FILTERS are used, + the trailing slash of TARGET is implied. + - Without FILTERS, install the full SOURCE _content_ to TARGET. + The paths relative to SOURCE are preserved within TARGET. + - With FILTERS among `#:include`, `#:include-regexp`, `#:exclude`, + `#:exclude-regexp`: + - With `#:include`, install only the paths which suffix exactly matches + one of the elements in the list. + - With `#:include-regexp`, install subpaths matching the regexps in the list. + - The `#:exclude*` FILTERS work similarly. Without `#:include*` flags, + install every subpath but the files matching the `#:exlude*` filters. + If both `#:include*` and `#:exclude*` are specified, the exclusion is done + on the inclusion list. + +Examples: + +- `(\"foo/bar\" \"share/my-app/\")`: Install bar to \"share/my-app/bar\". +- `(\"foo/bar\" \"share/my-app/baz\")`: Install bar to \"share/my-app/baz\". +- `(\"foo/\" \"share/my-app\")`: Install the content of foo inside \"share/my-app\", + e.g. install \"foo/sub/file\" to \"share/my-app/sub/file\". +- `(\"foo/\" \"share/my-app\" #:include (\"sub/file\"))`: Install only \"foo/sub/file\" to +\"share/my-app/sub/file\". +- `(\"foo/sub\" \"share/my-app\" #:include (\"file\"))`: Install \"foo/sub/file\" to +\"share/my-app/file\"." + (define (install-simple source target) + "Install SOURCE to TARGET. +TARGET must point to a store location. +SOURCE may be a file or a directory. +If a directory, the directory itself is installed, not its content. +if TARGET ends with a '/', the source is installed underneath." + (let ((target (if (string-suffix? "/" target) + (string-append target (basename source)) + target))) + (mkdir-p (dirname target)) + (copy-recursively source target))) + + (define (install-file file target) + (let ((dest (string-append target + (if (string-suffix? "/" target) + (string-append "/" file) + file)))) + (format (current-output-port) "`~a' -> `~a'~%" file dest) + (mkdir-p (dirname dest)) + (copy-file file dest))) + + (define* (make-file-predicate suffixes matches-regexp #:optional (default-value #t)) + "Return a predicate that returns #t if its file argument matches the +SUFFIXES or the MATCHES-REGEXP. If neither SUFFIXES nor MATCHES-REGEXP is +given, then the predicate always returns DEFAULT-VALUE." + (if (or suffixes matches-regexp) + (let* ((suffixes (or suffixes '())) + (regexps (map make-regexp (or matches-regexp '()))) + (predicates (append + (map (lambda (str) + (cut string-suffix? str <>)) + suffixes) + (map (lambda (regexp) + (cut regexp-exec regexp <>)) + regexps)))) + (lambda (file) + (any (cut <> file) predicates))) + (const default-value))) + + (define* (install-file-list source target #:key include exclude include-regexp exclude-regexp) + ;; We must use switch current directory to source so that `find-files' + ;; returns file paths relative to source. + (with-directory-excursion source + (let* ((exclusion-pred (negate (make-file-predicate exclude exclude-regexp #f))) + (inclusion-pred (make-file-predicate include include-regexp)) + (file-list + (filter! exclusion-pred + (find-files "." (lambda (file _stat) + (inclusion-pred file)))))) + (map (cut install-file <> (if (string-suffix? "/" target) + target + (string-append target "/"))) + file-list)))) + + (define* (install source target #:key include exclude include-regexp exclude-regexp) + (set! target (string-append (assoc-ref outputs "out") "/" target)) + (let ((filters? (or include exclude include-regexp exclude-regexp))) + (when (and (not (file-is-directory? source)) + filters?) + (error "Cannot use filters when SOURCE is a file.")) + (let ((multi-files-in-source? + (or (string-suffix? "/" source) + (and (file-is-directory? source) + filters?)))) + (if multi-files-in-source? + (install-file-list source target + #:include include + #:exclude exclude + #:include-regexp include-regexp + #:exclude-regexp exclude-regexp) + (install-simple source target))))) + + (for-each (lambda (plan) (apply install plan)) install-plan) + #t) + +(define %standard-phases + ;; Everything is as with the GNU Build System except for the `configure' + ;; , `build', `check' and `install' phases. + (modify-phases gnu:%standard-phases + (delete 'bootstrap) + (delete 'configure) + (delete 'build) + (delete 'check) + (replace 'install install))) + +(define* (copy-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; copy-build-system.scm ends here |