From patchwork Fri Feb 14 12:53:56 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Pierre Neidhardt X-Patchwork-Id: 20248 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 16DE027BBEA; Fri, 14 Feb 2020 12:55:19 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id F27E527BBE4 for ; Fri, 14 Feb 2020 12:55:17 +0000 (GMT) Received: from localhost ([::1]:38174 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j2aV3-0007LX-HZ for patchwork@mira.cbaines.net; Fri, 14 Feb 2020 07:55:17 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:43097) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j2aUr-0007Am-Oa for guix-patches@gnu.org; Fri, 14 Feb 2020 07:55:08 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j2aUp-0006Ny-FC for guix-patches@gnu.org; Fri, 14 Feb 2020 07:55:05 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:54995) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1j2aUp-0006Mz-Ao for guix-patches@gnu.org; Fri, 14 Feb 2020 07:55:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1j2aUo-00076z-Am for guix-patches@gnu.org; Fri, 14 Feb 2020 07:55:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#39599] [PATCH 1/2] build-system: Add copy-build-system. References: <20200214125144.4185-1-mail@ambrevar.xyz> In-Reply-To: <20200214125144.4185-1-mail@ambrevar.xyz> Resent-From: Pierre Neidhardt Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 14 Feb 2020 12:55:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 39599 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 39599@debbugs.gnu.org Received: via spool by 39599-submit@debbugs.gnu.org id=B39599.158168484327254 (code B ref 39599); Fri, 14 Feb 2020 12:55:02 +0000 Received: (at 39599) by debbugs.gnu.org; 14 Feb 2020 12:54:03 +0000 Received: from localhost ([127.0.0.1]:60967 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1j2aTq-00075Q-K4 for submit@debbugs.gnu.org; Fri, 14 Feb 2020 07:54:03 -0500 Received: from relay4-d.mail.gandi.net ([217.70.183.196]:55731) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1j2aTn-00074r-Vt for 39599@debbugs.gnu.org; Fri, 14 Feb 2020 07:54:01 -0500 X-Originating-IP: 92.169.129.147 Received: from bababa.home (lfbn-idf2-1-1315-147.w92-169.abo.wanadoo.fr [92.169.129.147]) (Authenticated sender: mail@ambrevar.xyz) by relay4-d.mail.gandi.net (Postfix) with ESMTPSA id 4BFE8E000B for <39599@debbugs.gnu.org>; Fri, 14 Feb 2020 12:53:57 +0000 (UTC) From: Pierre Neidhardt Date: Fri, 14 Feb 2020 13:53:56 +0100 Message-Id: <20200214125357.5262-1-mail@ambrevar.xyz> X-Mailer: git-send-email 2.25.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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'. --- Makefile.am | 2 + doc/guix.texi | 57 +++++++++++ guix/build-system/copy.scm | 145 ++++++++++++++++++++++++++++ guix/build/copy-build-system.scm | 156 +++++++++++++++++++++++++++++++ 4 files changed, 360 insertions(+) create mode 100644 guix/build-system/copy.scm create mode 100644 guix/build/copy-build-system.scm 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 42d7cfa2e8..d1ec214674 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6159,6 +6159,63 @@ 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 implied by the +@code{trivial-build-system}. + +To further simplify the file installation process, an +@code{#:install-plan} argument is exposed to let the packaer 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. + @itemize + @item Without @code{FILTERS}, install the full @code{SOURCE} @emph{content} to @code{TARGET}. + The paths relative to @code{SOURCE} are preserved within @code{TARGET}. + @item With @code{FILTERS} among @code{#:include}, @code{#:include-regexp}, @code{exclude}, + @code{#:exclude-regexp}: + @itemize + @item With @code{#:include}, install only the exact subpaths in the list. + @item With @code{#:include-regexp}, install subpaths matching the regexps in the list. + @item The @code{#:exclude} and @code{#:exclude-regexp} filters work similarly. Without @code{#:include} flags, + install every subpath but the files matching the exclusion filters. + If both inclusions and exclusions are specified, the exclusions are done + on the inclusion list. + @end itemize + @end itemize +@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}t o @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 + + @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..9686e7e5c2 --- /dev/null +++ b/guix/build-system/copy.scm @@ -0,0 +1,145 @@ +;;; 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-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." + (define private-keywords + '(#:source #:target #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (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..c9c8f1165b --- /dev/null +++ b/guix/build/copy-build-system.scm @@ -0,0 +1,156 @@ +;;; 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 exact subpaths 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) + "TARGET must point to a store location." + (set! 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 matches matches-regexp) + (if (or matches matches-regexp) + (lambda (file) + (any (lambda (pred) (pred file)) + (append + (map (lambda (str) + (lambda (f) (string-contains f str))) + (or matches '())) + (map (lambda (regexp) + (lambda (f) (regexp-exec (make-regexp regexp) f))) + (or matches-regexp '()))))) + (const #t))) + + (define* (install-file-list source target #:key include exclude include-regexp exclude-regexp) + (let* ((exclusion-pred (negate (make-file-predicate exclude exclude-regexp))) + (inclusion-pred (make-file-predicate include include-regexp)) + (file-list + (filter exclusion-pred + ;; We must use switch current directory to source so + ;; that `find-files' returns file paths relative to + ;; source. + (with-directory-excursion source + (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