From e90e64049ce160d28d1e8b3014badcc2b214627c Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 14 Feb 2020 10:30:31 +0100 Subject: 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'. --- guix/build/copy-build-system.scm | 165 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) create mode 100644 guix/build/copy-build-system.scm (limited to 'guix/build/copy-build-system.scm') 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 +;;; Copyright © 2020 Pierre Neidhardt +;;; +;;; 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 . + +(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 -- cgit v1.2.3