build-system: Add copy-build-system.

* guix/build-system/copy.scm: New file.
* guix/build/copy-build-system.scm: New file.
* Makefile.am (MODULES): Add them.
* doc/guix.texi (Build Systems): Document 'copy-build-system'.
This commit is contained in:
Pierre Neidhardt 2020-02-14 10:30:31 +01:00
parent 6ca4e98c56
commit e90e64049c
No known key found for this signature in database
GPG key ID: 9BDCF497A4BBCC7F
4 changed files with 374 additions and 0 deletions

View file

@ -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 \

View file

@ -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

143
guix/build-system/copy.scm Normal file
View file

@ -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

View file

@ -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