Message ID | a3e5ae0f3235df996b4be479f107680ae769a3c4.1698590244.git.phfrohring@deeplinks.com |
---|---|
State | New |
Headers | show |
Series | [bug#66801,va3e5ae0f..37252e07,01/32] rebar-build-system and packages. | expand |
Am Sonntag, dem 29.10.2023 um 15:36 +0100 schrieb Pierre-Henry Fröhring: > [PATCH va3e5ae0f..37252e07 01/32] The middle should indicate a revision number and an optional branch (as well as optional WIP and RFC). Since this goes to master (I assume), it should just be v2, v3, … vN > The builder now accepts the `#:sources-erlang` parameter, which > expects a list of "Source" items. Each "Source" corresponds to the > source code of a library directory, which is where Erlang looks for > compiled modules. > Documentation: > https://www.erlang.org/doc/man/code#code-path. Each Source is > installed as a "Checkout", which are local dependencies linked to > directories managed by rebar. For more information, see > https://rebar3.org/docs/configuration/dependencies/#checkout-dependencies > . Lacking checkouts, rebar3 will not compile if there is no network > access. > > Change-Id: Idc3aa8bb204f55d0594c1669399845cd9b9e86ab > --- > guix/build-system/rebar.scm | 274 +++++++++++++++++++--------- > -- > guix/build/rebar-build-system.scm | 255 +++++++++++++++++---------- > 2 files changed, 339 insertions(+), 190 deletions(-) > > diff --git a/guix/build-system/rebar.scm b/guix/build- > system/rebar.scm > index de1294ec..862721ee 100644 > --- a/guix/build-system/rebar.scm > +++ b/guix/build-system/rebar.scm > @@ -1,6 +1,7 @@ > ;;; GNU Guix --- Functional package management for GNU > ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> > ;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> > +;;; Copyright © 2023 Pierre-Henry Fröhring > <phfrohring@deeplinks.com> > ;;; > ;;; This file is part of GNU Guix. > ;;; > @@ -18,102 +19,117 @@ > ;;; along with GNU Guix. If not, see > <http://www.gnu.org/licenses/>. > > (define-module (guix build-system rebar) > - #:use-module (guix store) > - #:use-module (guix utils) > + #:use-module (guix build-system gnu) > + #:use-module (guix build-system) > #:use-module (guix gexp) > - #:use-module (guix packages) > #:use-module (guix monads) > + #:use-module (guix packages) > #:use-module (guix search-paths) > - #:use-module (guix build-system) > - #:use-module (guix build-system gnu) > - #:export (hexpm-uri > - hexpm-package-url > - %rebar-build-system-modules > - rebar-build > - rebar-build-system)) > + #:use-module (guix store) > + #:use-module (guix utils) > + #:use-module (ice-9 match) > + #:use-module (ice-9 regex) > + #:use-module (srfi srfi-1) > + #:export (hexpm-uri hexpm-package-url %rebar-build-system-modules > + rebar-build rebar-build-system)) > > -;;; > -;;; Definitions for the hex.pm repository, > -;;; > +;; Source > +;; A « Source » reprensents the source code to a library > directory. It is > +;; defined as (list <name> <origin>) where: <name> is a string > representing > +;; the name of a library directory and <origin> is an origin as > defined > +;; (guix packages). > + > + > +;; Pattern that an Erlang Guix package name is expected to match. > +(define pkg-name-re "^erlang-(.*)") Emacs, Rust, etc. build systems just strip out the prefix. No need to go all fancy regexpy :) > +(define (pkg-name->match name) > + "Return the match object from NAME if NAME starts with pkg-name- > prefix." > + (string-match pkg-name-re name)) > + > +(define (pkg-name? name) > + "Test if NAME is the name of an Erlang Guix package." > + (or (pkg-name->match name) #f)) > > -;; URL and paths from > -;; https://github.com/hexpm/specifications/blob/master/endpoints.md > -(define %hexpm-repo-url > - (make-parameter "https://repo.hex.pm")) > +(define (pkg-name->suffix name) > + "Return the suffix of the name of an Erlang Guix package." > + (regexp-substitute #f (pkg-name->match name) 1)) > > -(define hexpm-package-url > - (string-append (%hexpm-repo-url) "/tarballs/")) > +(define* (pkg-name->library-directory-name name #:key (version "")) > + "Return the name of the library directory associated with the > Erlang Guix package name NAME." > + (string-append (string-replace-substring (pkg-name->suffix name) > "-" "_") > + (if (string= version "") "" (string-append "-" > version)))) > + > +;; See: > https://github.com/hexpm/specifications/blob/master/endpoints.md > +(define hexpm (make-parameter "https://repo.hex.pm")) > + > +(define hexpm-tarballs (string-append (hexpm) "/tarballs/")) > > (define (hexpm-uri name version) > "Return a URI string for the package hosted at hex.pm > corresponding to NAME > -and VERSION." > - (string-append hexpm-package-url name "-" version ".tar")) > +and VERSION. > > -;; > -;; Standard build procedure for Erlang packages using Rebar. > -;; > +XXX: should a warning be emitted? > +If NAME is not an Erlang Guix package name, then emit a warning. The > download > +will fail if it is not correct anyway." > > -(define %rebar-build-system-modules > - ;; Build-side modules imported by default. > - `((guix build rebar-build-system) > - ,@%gnu-build-system-modules)) > + (define (warn-about name) > + (format #t "AssertionWarning 4dcbff27 > + Assertion: re matches name. > + re = ~a > + name = ~a > +" pkg-name-re name) > + > + name) 何で? > > -(define (default-rebar3) > - "Return the default Rebar3 package." > + (define (name->archive-name name) > + (if (pkg-name? name) > + (string-append (pkg-name->library-directory-name name > #:version version) ".tar") > + (string-append (warn-about name) "-" version ".tar"))) > + > + (string-append hexpm-tarballs (name->archive-name name))) > + > +(define (rebar-default) > ;; Lazily resolve the binding to avoid a circular dependency. > (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) > (module-ref erlang-mod 'rebar3))) I suggest not to rename these procedures. default-X reads more naturally than X-default. > -(define (default-erlang) > - "Return the default Erlang package." > +(define (erlang-default) > ;; Lazily resolve the binding to avoid a circular dependency. > (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) > (module-ref erlang-mod 'erlang))) > > -(define* (lower name > - #:key source inputs native-inputs outputs system > target > - (rebar (default-rebar3)) > - (erlang (default-erlang)) > - #:allow-other-keys > - #:rest arguments) > - "Return a bag for NAME from the given arguments." > - (define private-keywords > - '(#:target #:rebar #:erlang #:inputs #:native-inputs)) > - > - (and (not target) ;XXX: no cross- > compilation > - (bag > - (name name) > - (system system) > - (host-inputs `(,@(if source > - `(("source" ,source)) > - '()) > - ,@inputs)) > - (build-inputs `(("rebar" ,rebar) > - ("erlang" ,erlang) ;; for escriptize > - ,@native-inputs > - ;; Keep the standard inputs of 'gnu-build- > system'. > - ,@(standard-packages))) > - (outputs outputs) > - (build rebar-build) > - (arguments (strip-keyword-arguments private-keywords > arguments))))) > - > -(define* (rebar-build name inputs > - #:key > - guile source > - (rebar-flags ''("skip_deps=true" "-vv")) > - (tests? #t) > - (test-target "eunit") > - ;; TODO: install-name ; default: based on > guix package name > - (install-profile "default") > - (phases '(@ (guix build rebar-build-system) > - %standard-phases)) > - (outputs '("out")) > - (search-paths '()) > - (native-search-paths '()) > - (system (%current-system)) > - (imported-modules %rebar-build-system- > modules) > - (modules '((guix build rebar-build-system) > - (guix build utils)))) > +(define imported-modules > + `((guix build rebar-build-system) > + ,@%gnu-build-system-modules)) > + > +(define (input->source input) > + "Return a Source associated to the Input INPUT." > + (match input > + ((name package) > + (list (pkg-name->library-directory-name name) > + (package-source package))))) > + > +(define* (rebar-build name > + inputs > + #:key > + guile > + source > + (rebar-flags ''()) > + (tests? #t) > + (test-target "eunit") > + ;; TODO: install-name ; default: based on > guix package name > + (install-profile "default") > + (phases '(@ (guix build rebar-build-system) > + %standard-phases)) > + (outputs '("out")) > + (search-paths '()) > + (native-search-paths '()) > + (system (%current-system)) > + (imported-modules imported-modules) > + (modules '((guix build rebar-build-system) > + (guix build utils))) > + (sources-erlang '())) > "Build SOURCE with INPUTS." > > (define builder > @@ -122,35 +138,95 @@ (define* (rebar-build name inputs > (use-modules #$@(sexp->gexp modules)) > > #$(with-build-variables inputs outputs > + > #~(rebar-build #:source #+source > - #:system #$system > - #:name #$name > - #:rebar-flags #$rebar-flags > - #:tests? #$tests? > - #:test-target #$test-target > - ;; TODO: #:install-name #$install-name > - #:install-profile #$install-profile > - #: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))) > + #:sources-erlang '#$sources-erlang This reeks of the hack that we need for cargo-build-system, except with a worse variable name. I strongly suggest looking into ways we can do without it. > + #:system #$system > + #:name #$name > + #:rebar-flags #$rebar-flags > + #:tests? #$tests? > + #:test-target #$test-target > + ;; TODO: #:install-name #$install-name > + #:install-profile #$install-profile > + #: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))) > + > ;; Note: Always pass #:graft? #f. Without it, ALLOWED- > REFERENCES & > ;; co. would be interpreted as referring to grafted packages. > - (gexp->derivation name builder > + (gexp->derivation name > + builder > #:system system > #:target #f > #:graft? #f > #:guile-for-build guile))) > > +(define* (lower name > + #:key > + (erlang (erlang-default)) > + inputs > + native-inputs > + outputs > + (rebar (rebar-default)) > + source > + system > + target > + #:allow-other-keys #:rest arguments) > + "Return a bag for NAME from the given arguments." > + > + (let* ((erlang-packages > + (filter (lambda (input) > + (match input > + ((name _) (pkg-name? name)))) > + (append inputs native-inputs))) > + > + (erlang-sources (map input->source erlang-packages))) > + > + (define private-keywords > + '(#:target #:rebar #:erlang #:inputs #:native-inputs > #:sources-erlang)) > + > + (and (not target) ;XXX: no cross-compilation > + (bag (name name) > + (system system) > + (host-inputs inputs) > + (build-inputs `(,@(standard-packages) > + ("erlang" ,erlang) > + ("rebar" ,rebar) > + ,@inputs > + ,@native-inputs)) > + (outputs outputs) > + (build rebar-build) > + (arguments (append (list #:sources-erlang erlang- > sources) > + (strip-keyword-arguments private- > keywords > + > arguments))))))) > + > (define rebar-build-system > - (build-system > - (name 'rebar) > - (description "The standard Rebar build system") > - (lower lower))) > + (build-system (name 'rebar) > + (description "The standard Rebar build system") > + (lower lower))) > + > + > +;;; > +;;; Exports > +;;; > + > +(define hexpm-package-url hexpm-tarballs) > + > +(define %rebar-build-system-modules imported-modules) > + > + > +;;; rebar.scm ends here > diff --git a/guix/build/rebar-build-system.scm b/guix/build/rebar- > build-system.scm > index fb664228..b68348bd 100644 > --- a/guix/build/rebar-build-system.scm > +++ b/guix/build/rebar-build-system.scm > @@ -2,6 +2,7 @@ > ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net> > ;;; Copyright © 2019 Björn Höfling > <bjoern.hoefling@bjoernhoefling.de> > ;;; Copyright © 2020, 2022 Hartmut Goebel > <h.goebel@crazy-compilers.com> > +;;; Copyright © 2023 Pierre-Henry Fröhring > <phfrohring@deeplinks.com> > ;;; > ;;; This file is part of GNU Guix. > ;;; > @@ -23,125 +24,197 @@ (define-module (guix build rebar-build-system) > #:use-module ((guix build utils) #:hide (delete)) > #:use-module (ice-9 match) > #:use-module (ice-9 ftw) > + #:use-module (ice-9 string-fun) > + #:use-module (ice-9 receive) > + #:use-module (ice-9 regex) > #:use-module (srfi srfi-1) > #:use-module (srfi srfi-26) > - #:export (rebar-build > - %standard-phases)) > + #:export (rebar-build %standard-phases)) > > ;; > ;; Builder-side code of the standard build procedure for Erlang > packages using > ;; rebar3. > ;; > -;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and > includedir > -;; "(include") need to be configurable > +;; Library directory > +;; A « library directory » is a directory where Erlang searches > for compiled > +;; code. Its name should look like: `a_name-1.2.3' where the > suffix `-1.2.3' > +;; is optional. See: > https://www.erlang.org/doc/man/code#code-path. > +;; > +;; Package name > +;; A « package name » is the value of the name field of a package > +;; definition. It looks like: `prefix-a-name-1.2.3'. See: > +;; https://guix.gnu.org/manual/en/html_node/Package-Naming.html > +;; > +;; Profile > +;; For Rebar3, a « profile » is a name associated to a set of > configuration > +;; settings overriding or complementing the regular configuration. > See: > +;; https://rebar3.org/docs/configuration/profiles > +;; > +;; Source > +;; A « source » represents the source code associated to a Guix > package as > +;; defined by its `source' field. Here, the data sctructure used > to > +;; represent a source has the form `(list name path)' where `name' > is a > +;; library directory name and `path' is the store path where to > find the > +;; source code. > +;; > +;; Checkout > +;; A « checkout » is a locally defined dependency related to a > directory > +;; managed by rebar. See: > +;; > https://rebar3.org/docs/configuration/dependencies/#checkout-dependencies > > -(define %erlang-libdir "/lib/erlang/lib") > +(define sep "/") Uhm, did you mean file-name-separator-string from Guile core? > -(define* (erlang-depends #:key inputs #:allow-other-keys) > - (define input-directories > - (match inputs > - (((_ . dir) ...) > - dir))) > - (mkdir-p "_checkouts") > - > - (for-each > - (lambda (input-dir) > - (let ((elibdir (string-append input-dir %erlang-libdir))) > - (when (directory-exists? elibdir) > - (for-each > - (lambda (dirname) > - (let ((dest (string-append elibdir "/" dirname)) > - (link (string-append "_checkouts/" dirname))) > - (when (not (file-exists? link)) > - ;; RETHINK: Maybe better copy and make writable to > avoid some > - ;; error messages e.g. when using with rebar3-git- > vsn. > - (symlink dest link)))) > - (list-directories elibdir))))) > - input-directories)) > +;; Where Erlang libraries are installed relative to a package path > in the store. > +(define lib-erlang-lib "lib/erlang/lib") > + > +(define (list-directories directory) > + "Return file names of the sub-directory of DIRECTORY." > + (scandir directory > + (lambda (file) > + (and (not (member file '("." ".."))) > + (file-is-directory? (string-append directory sep > file)))))) We have find-files? > + > +(define* (pkg-name->libdir-name name) > + "Return the library name deduced from the Erlang package name > NAME." > + (let* ((suffix (regexp-substitute #f (string-match "^erlang-(.*)" > name) 1)) > + (elements (string-split suffix #\-))) > + (string-append (string-join (drop-right elements 1) "_") "-" > (last elements)))) > + > +(define (libdir-name->prefix name) > + "Return the prefix of a library directory name NAME." > + (car (string-split name #\-))) > + > +(define (rebar-build-dir profile) > + "Return the path where rebar builds libraries given the profile > PROFILE." > + (format #f "_build/~a/lib" profile)) > + > +(define* (pkg-name->build-dir name #:key (profile "default")) > + "Return the path of library directory where rebar3 builds code of > an Erlang package named NAME given the profile PROFILE." > + (string-append (rebar-build-dir profile) sep (libdir-name->prefix > (pkg-name->libdir-name name)))) > > (define* (unpack #:key source #:allow-other-keys) > - "Unpack SOURCE in the working directory, and change directory > within the > -source. When SOURCE is a directory, copy it in a sub-directory of > the current > -working directory." > - (let ((gnu-unpack (assoc-ref gnu:%standard-phases 'unpack))) > - (gnu-unpack #:source source) > - ;; Packages from hex.pm typically have a contents.tar.gz > containing the > - ;; actual source. If this tar file exists, extract it. > - (when (file-exists? "contents.tar.gz") > - (invoke "tar" "xvf" "contents.tar.gz")))) > - > -(define* (build #:key (rebar-flags '()) #:allow-other-keys) > + (if (file-is-directory? source) > + ;; If source is a checkout: > + (begin > + ;; Preserve timestamps (set to the Epoch) on the copied tree > so that > + ;; things work deterministically. > + (copy-recursively source "." #:keep-mtime? #t) > + ;; Make the source checkout files writable, for convenience. > + (for-each (lambda (f) > + (false-if-exception (make-file-writable f))) > + (find-files "."))) > + > + ;; If source is an hex.pm archive: > + (begin > + (invoke "tar" "xvf" source) > + (invoke "tar" "xvf" "contents.tar.gz") > + > + ;; Prevent an error message during the install phase. > + ;; `rebar3 compile' produces symlinks like so in _build/: > + ;; priv -> ../../../../priv > + ;; include -> ../../../../include > + ;; > + ;; The install phase copies whatever has been built to the > output directory. > + ;; If the priv/ directory is absent, then an error `i/o > error: > + ;; _build/…/priv: No such file or directory' occurs. So, > we make sure that a > + ;; directory exists. > + (for-each (lambda (dir) (mkdir-p dir)) (list "priv" > "include"))))) Uhm, how are you improving the status quo here? > + > +(define (configure-HOME . ignored_args) Just _ is fine for ignored arguments. > + "In some cases, it is needed for the environment variable HOME to > be defined > +as a directory with write permission. Examples of errors: > + > +Could not write to \"/homeless-shelter/.cache/rebar3/hex\". Please > ensure the path is writeable. > +" > + (let ((HOME "HOME") > + (tmp "/tmp")) > + (setenv HOME tmp) > + (format #t "~a=~a\n" HOME tmp))) The canonical way is to use (getcwd) as HOME. You can could also try something like (canonicalize-path "../hexpm-home"). Anyhow, you might want to try using a variable that is less global than HOME. > +(define* (configure-dependencies #:key > + (install-profile "default") > + inputs > + name > + sources-erlang ;List of Source. > + version > + #:allow-other-keys) > + "Rebar3 refuses to compile without network access unless its > dependencies are > +present as source checkouts. To prevent unnecessary compilations, we > must « > +pre-install » dependencies in Rebar's build directory." I suggest not using french quotes – they are confusing between French and German native speakers :) You might want to look into possible PATH variables or put these sources into a special folder so that you can use search-path-as-list. Also, IIUC erlang-depends already does something rather similar. Is there any reason it's broken for you? > + > + ;; If source in sources-erlang, then install it under _checkouts/. > + (let ((_checkouts "_checkouts")) > + (mkdir-p _checkouts) > + > + (define (install-source source) > + "Install the Source SOURCE in _checkouts." > + (match source > + ((name path) > + (let ((src (string-append _checkouts sep name))) > + (mkdir-p src) > + (with-directory-excursion src (unpack #:source path)))) > + (_ #f))) > + > + (for-each install-source sources-erlang)) > + > + ;; If input in inputs is an Erlang package, then install it under > _build/. > + (let ((_build (format #f "_build/~a/checkouts" install-profile))) > + (mkdir-p _build) > + > + (define (install-libdir elib name dest) > + "Install the library directory named NAME from ELIB to DEST." > + (let ((src (string-append elib sep name)) > + (dest (string-append dest sep (libdir-name->prefix > name)))) > + (copy-recursively src dest) > + (mkdir-p (string-append dest "/priv")))) > + > + (define (install-all-libdirs dir dest) > + "Install in DEST all library directories in DIR." > + (let ((elib (string-append dir sep lib-erlang-lib))) > + (when (directory-exists? elib) > + (for-each (lambda (name) (install-libdir elib name dest)) > + (list-directories elib))))) > + > + (match inputs > + (((_ . dirs) ..1) > + (for-each > + (lambda (dir) (install-all-libdirs dir _build)) > + dirs)) > + (_ #f)))) > + > +(define* (build #:key name (rebar-flags '()) #:allow-other-keys) > (apply invoke `("rebar3" "compile" ,@rebar-flags))) > > -(define* (check #:key target (rebar-flags '()) (tests? (not target)) > +(define* (check #:key target > + (rebar-flags '()) > + (tests? (not target)) > (test-target "eunit") > #:allow-other-keys) > (if tests? > (apply invoke `("rebar3" ,test-target ,@rebar-flags)) > (format #t "test suite not run~%"))) > > -(define (erlang-package? name) > - "Check if NAME correspond to the name of an Erlang package." > - (string-prefix? "erlang-" name)) > - > -(define (package-name-version->erlang-name name+ver) > - "Convert the Guix package NAME-VER to the corresponding Erlang > name-version > -format. Essentially drop the prefix used in Guix and replace dashes > by > -underscores." > - (let* ((name- (package-name->name+version name+ver))) > - (string-join > - (string-split > - (if (erlang-package? name-) ; checks for "erlang-" prefix > - (string-drop name- (string-length "erlang-")) > - name-) > - #\-) > - "_"))) > - > -(define (list-directories directory) > - "Return file names of the sub-directory of DIRECTORY." > - (scandir directory > - (lambda (file) > - (and (not (member file '("." ".."))) > - (file-is-directory? (string-append directory "/" > file)))))) > - > -(define* (install #:key name outputs > - (install-name (package-name-version->erlang-name > name)) > - (install-profile "default") ; build profile > outputs to install > - #:allow-other-keys) > - (let* ((out (assoc-ref outputs "out")) > - (pkg-dir (string-append out %erlang-libdir "/" install- > name))) > - (let ((bin-dir (string-append "_build/" install-profile "/bin")) > - (lib-dir (string-append "_build/" install-profile > "/lib"))) > - ;; install _build/PROFILE/bin > - (when (file-exists? bin-dir) > - (copy-recursively bin-dir out #:follow-symlinks? #t)) > - ;; install _build/PROFILE/lib/*/{ebin,include,priv} > - (for-each > - (lambda (*) > - (for-each > - (lambda (dirname) > - (let ((src-dir (string-append lib-dir "/" * "/" > dirname)) > - (dst-dir (string-append pkg-dir "/" dirname))) > - (when (file-exists? src-dir) > - (copy-recursively src-dir dst-dir #:follow-symlinks? > #t)) > - (false-if-exception > - (delete-file (string-append dst-dir > "/.gitignore"))))) > - '("ebin" "include" "priv"))) > - (list-directories lib-dir)) > - (false-if-exception > - (delete-file (string-append pkg-dir "/priv/Run-eunit- > loop.expect")))))) > +(define* (install #:key name outputs (install-profile "default") > #:allow-other-keys) > + (let* ((src (pkg-name->build-dir name #:profile install-profile)) > + (dest (string-append (assoc-ref outputs "out") > + sep lib-erlang-lib sep > + (pkg-name->libdir-name name)))) > + (mkdir-p dest) > + (copy-recursively src dest #:follow-symlinks? #t))) > > (define %standard-phases > (modify-phases gnu:%standard-phases > (replace 'unpack unpack) > + (add-after 'unpack 'configure-HOME configure-HOME) > (delete 'bootstrap) > (delete 'configure) > - (add-before 'build 'erlang-depends erlang-depends) > + (add-before 'build 'configure-dependencies configure- > dependencies) > (replace 'build build) > (replace 'check check) > (replace 'install install))) > > -(define* (rebar-build #:key inputs (phases %standard-phases) > - #:allow-other-keys #:rest args) > +(define* (rebar-build #:key inputs (phases %standard-phases) > #:allow-other-keys #:rest args) > "Build the given Erlang package, applying all of PHASES in order." > (apply gnu:gnu-build #:inputs inputs #:phases phases args)) > + > +;;; rebar-build-system.scm ends here > > base-commit: 4dfbc536689b07e56aead3dd864b8af54613d091 > -- > 2.41.0 Cheers
> The middle should indicate a revision number and an optional branch > (as well as optional WIP and RFC). Since this goes to master (I > assume), it should just be v2, v3, … vN. DONE: Ok. If I understood correctly, it means that it should have been [PATCH v2]. So this time, it will be [PATCH v3]. > Emacs, Rust, etc., build systems just strip out the prefix. No need > to go all fancy regexpy :)何で? WAITING: Well, it makes the warning message completely explicit, for example: ┌──── │ AssertionWarning 4dcbff27 │ Assertion: re matches name. │ re = ^erlang-(.*) │ name = something-else └──── Is it OK if it stays like this? > I suggest not renaming these procedures. default-X reads more > naturally than X-default. DONE. > This reeks of the hack that we need for cargo-build-system, except > with a worse variable name. I strongly suggest looking into ways we > can do without it. WAITING: this idea came from a discussion with jpoiret. See: <https://logs.guix.gnu.org/guix/2023-10-24.log#180111>. It seems that the idea you suggest is to use `search-path-as-list' as hinted below. Is this correct? > Uhm, did you mean file-name-separator-string from Guile core? DONE: Great. That is what I was searching for; I'm not yet familiar with the standard library. > We have find-files? DONE: replaced. > Uhm, how are you improving the status quo here? WAITING: comment updated with: ┌──── │ ;; If these directories exist, then no error occurs. So, we make sure │ ;; they exist. └──── Is this OK? > The canonical way is to use (getcwd) as HOME. You could also try > something like (canonicalize-path "../hexpm-home"). Anyhow, you might > want to try using a variable that is less global than HOME. DONE: HOME has been replaced by REBAR_CACHE_DIR. > I suggest not using French examples – they are confusing between > French and German native speakers :) DONE: « → “, » → ” > You might want to look into possible PATH variables or put these > sources into a special folder so that you can use search-path-as-list. WAITING: Perhaps an idea: 1) If we require all Erlang packages to have an output “src” something like: /gnu/store/…elixir-pkg-1.2.3/src/elixir/src/…, 2) then (search-path-as-list '("src/elixir/src") '("/gnu/store…elixir-pkg-1.2.3" …)) would return '("/gnu/store…elixir-pkg-1.2.3/src/elixir/src" …) ≡ lst-src. 3) Given lst-src, it would be enough to install each source under _checkouts, i.e., _checkouts/lib-name/src. It is probably feasible to retrieve lib-name from somewhere. What do you think? > Also, IIUC, erlang-depends already does something rather similar. Is > there any reason it's broken for you? WAITING: Without that (i.e., _checkouts/lib-name/src), rebar3 will not compile things. Is this a satisfaying explaination?
Am Sonntag, dem 29.10.2023 um 23:14 +0100 schrieb Pierre-Henry Fröhring: > n [PATCH v2]. So this time, it will be [PATCH v3]. > > > Emacs, Rust, etc., build systems just strip out the prefix. No > > need to go all fancy regexpy :)何で? > > WAITING: Well, it makes the warning message completely explicit, for > example: > ┌──── > │ AssertionWarning 4dcbff27 > │ Assertion: re matches name. > │ re = ^erlang-(.*) > │ name = something-else > └──── > Is it OK if it stays like this? You can use a shorter error and explain the problem better: "~a does not start with \"erlang-\"" name > > > Uhm, how are you improving the status quo here? > > WAITING: comment updated with: > ┌──── > │ ;; If these directories exist, then no error occurs. So, we make > sure > │ ;; they exist. > └──── > Is this OK? > > > [...] > > You might want to look into possible PATH variables or put these > > sources into a special folder so that you can use search-path-as- > > list. > > WAITING: Perhaps an idea: > 1) If we require all Erlang packages to have an output “src” > something > like: /gnu/store/…elixir-pkg-1.2.3/src/elixir/src/…, > 2) then (search-path-as-list '("src/elixir/src") > '("/gnu/store…elixir-pkg-1.2.3" …)) would return > '("/gnu/store…elixir-pkg-1.2.3/src/elixir/src" …) ≡ lst-src. > 3) Given lst-src, it would be enough to install each source under > _checkouts, i.e., _checkouts/lib-name/src. It is probably feasible > to > retrieve lib-name from somewhere. > What do you think? Rather than require, you can add a phase to ensure that this is the case. I'm not sure whether we should make that an extra output, however; there might be many packages for which we don't need those sources and where we do need them, we could potentially add them as native-inputs. Another alternative would be to keep the sources in lib/erlang/lib/lib-name/src so that it gets symlinked by the phase we have. Though at that point we can surely go with a less surprising install directory. > > Also, IIUC, erlang-depends already does something rather similar. > > Is there any reason it's broken for you? > > WAITING: Without that (i.e., _checkouts/lib-name/src), rebar3 will > not compile things. Is this a satisfaying explaination? I mean, ideally we would store these things in some other directory, given that _checkouts/lib-name already contains the precompiled stuff after erlang-depends. However, if the tooling insists on storing both in the same place, you could simply amend the existing erlang-depends phase to 1. Copy instead of symlinking 2. Also copy the sources Cheers
I've collected your comments in an org-file so that it's easier (at least for me, but I hope it's the case for you too) to follow multiple discussions at the same time. I've only included the ones that are still open to discussion. The structure should be self-evident. The most important comment may be Comment 9. Cheers. * TODO Comment 4 ** LMP This reeks of the hack that we need for cargo-build-system, except with a worse variable name. I strongly suggest looking into ways we can do without it. ** PHF This idea came from a discussion with jpoiret. See: https://logs.guix.gnu.org/guix/2023-10-24.log#180111. It seems that the idea you suggest is to use =search-path-as-list= as hinted below (=Comment 9=). Is this correct? * TODO Comment 6 ** LMP Uhm, how are you improving the status quo here? ** PHF Comment updated with: #+begin_example ;; If these directories exist, then no error occurs. So, we make sure ;; they exist. #+end_example Is this OK? I don't see how to prevent rebar3 to do that. It's apparently an opened issue: https://github.com/erlang/rebar3/issues/1173 * TODO Comment 9 ** LMP You might want to look into possible PATH variables or put these sources into a special folder so that you can use search-path-as-list. ** PHF Perhaps an idea: 1) If we require all Erlang packages to have an output “src” something like: /gnu/store/…elixir-pkg-1.2.3/src/elixir/src/…, 2) then (search-path-as-list '("src/elixir/src") '("/gnu/store…elixir-pkg-1.2.3" …)) would return '("/gnu/store…elixir-pkg-1.2.3/src/elixir/src" …) ≡ lst-src. 3) Given lst-src, it would be enough to install each source under _checkouts, i.e., _checkouts/lib-name/src. It is probably feasible to retrieve lib-name from somewhere. What do you think? ** LMP Rather than require, you can add a phase to ensure that this is the case. I'm not sure whether we should make that an extra output, however; there might be many packages for which we don't need those sources and where we do need them, we could potentially add them as native-inputs. ** PHF Agreed. ** LMP Another alternative would be to keep the sources in =lib/erlang/lib/lib-name/src= so that it gets symlinked by the phase we have. Though at that point we can surely go with a less surprising install directory. ** PHF Here is the approach taken so far: 1) The objective is to ensure that =mix compile= does not attempt to use the network and, as a result, fails to compile. 2) For the above to be true, it is necessary to have — at build time — the sources of all Erlang input packages and install them as checkouts. 3) Thus, the question becomes: How to access all the Erlang package sources at build time? 4) One idea was to have the client side of the build code send all the sources to the server through the poorly named argument =#:sources-erlang=. This led to the current code. It relies on the fact that for a given Erlang package, it is possible to access its source in the store, for example, =/gnu/store/…erlang-kv/erlang-kv.tar=. 5) Instead, you propose modifying the installation process so that sources are installed along with the built libraries. The source might be collected with =search-path-as-list=. The downside seems to be that the source code is stored twice: first in the archive, then in the package. However, this could lead to a much cleaner method of passing the sources to the build-side code, that is, the source code would not be passed through =arguments=. I'm sending a patch based on this latter idea. Are you OK with that? * TODO Comment 10 ** LMP Also, IIUC, erlang-depends already does something rather similar. Is there any reason it's broken for you? ** PHF Without that (i.e., _checkouts/lib-name/src), rebar3 will not compile things. Is this a satisfying explanation? ** LMP I mean, ideally we would store these things in some other directory, given that _checkouts/lib-name already contains the precompiled stuff after erlang-depends. However, if the tooling insists on storing both in the same place, you could simply amend the existing erlang-depends phase to: 1. Copy instead of symlinking 2. Also copy the sources ** PHF If I understand correctly, this should be addressed with the patch from =Comment 9= section above.
Am Montag, dem 30.10.2023 um 13:30 +0100 schrieb Pierre-Henry Fröhring: > [...] > Comment updated with: > #+begin_example > ;; If these directories exist, then no error occurs. So, we make > sure > ;; they exist. > #+end_example > Is this OK? > > I don't see how to prevent rebar3 to do that. It's apparently an > opened issue: > https://github.com/erlang/rebar3/issues/1173 I'd recommend sticking with the current flow, however, and either create those directories unconditionally or inside the (when (file-exists? …) …) In general, don't mix gratuitous "styling" changes into your commits. Try to keep your edits minimal and reviewable. > Here is the approach taken so far: > 1) The objective is to ensure that =mix compile= does not attempt to > use the network and, as a result, fails to compile. > 2) For the above to be true, it is necessary to have — at build time > — the sources of all Erlang input packages and install them as > checkouts. > 3) Thus, the question becomes: How to access all the Erlang package > sources at build time? > [...] One idea both of us haven't voiced so far is to actually grab these in the (guix build-system …) code rather than the (guix build …) side and make the sources available via a mapping. Think package → (package- source package). The downsides of this are quite obvious. First, to my knowledge something like that hasn't been done yet, so there's no reference point. Second, the (guix build …) side would still need to identify what's an erlang source. Given our code for the unpack phase, I'd hazard a guess that this is non-trivial. Thus, even if there's theoretically a way to not store the same tarball twice, in practice it doesn't really matter. You could alternatively also write the sources to a special source output if and only if one such output is requested via the outputs field. Again, I'd hazard a guess that this would be a very standard output for anything that needs to go into mix-build-system and thus not worth the split after all. Alternatively² you could patch mix to only look for compiled stuff and not sources. That would tackle the issue at the root instead of trying to work around it, with the caveat being that we would need to maintain this patch ourselves if upstream doesn't accept it. Cheers
diff --git a/guix/build-system/rebar.scm b/guix/build-system/rebar.scm index de1294ec..862721ee 100644 --- a/guix/build-system/rebar.scm +++ b/guix/build-system/rebar.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> +;;; Copyright © 2023 Pierre-Henry Fröhring <phfrohring@deeplinks.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,102 +19,117 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build-system rebar) - #:use-module (guix store) - #:use-module (guix utils) + #:use-module (guix build-system gnu) + #:use-module (guix build-system) #:use-module (guix gexp) - #:use-module (guix packages) #:use-module (guix monads) + #:use-module (guix packages) #:use-module (guix search-paths) - #:use-module (guix build-system) - #:use-module (guix build-system gnu) - #:export (hexpm-uri - hexpm-package-url - %rebar-build-system-modules - rebar-build - rebar-build-system)) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:export (hexpm-uri hexpm-package-url %rebar-build-system-modules + rebar-build rebar-build-system)) -;;; -;;; Definitions for the hex.pm repository, -;;; +;; Source +;; A « Source » reprensents the source code to a library directory. It is +;; defined as (list <name> <origin>) where: <name> is a string representing +;; the name of a library directory and <origin> is an origin as defined +;; (guix packages). + + +;; Pattern that an Erlang Guix package name is expected to match. +(define pkg-name-re "^erlang-(.*)") + +(define (pkg-name->match name) + "Return the match object from NAME if NAME starts with pkg-name-prefix." + (string-match pkg-name-re name)) + +(define (pkg-name? name) + "Test if NAME is the name of an Erlang Guix package." + (or (pkg-name->match name) #f)) -;; URL and paths from -;; https://github.com/hexpm/specifications/blob/master/endpoints.md -(define %hexpm-repo-url - (make-parameter "https://repo.hex.pm")) +(define (pkg-name->suffix name) + "Return the suffix of the name of an Erlang Guix package." + (regexp-substitute #f (pkg-name->match name) 1)) -(define hexpm-package-url - (string-append (%hexpm-repo-url) "/tarballs/")) +(define* (pkg-name->library-directory-name name #:key (version "")) + "Return the name of the library directory associated with the Erlang Guix package name NAME." + (string-append (string-replace-substring (pkg-name->suffix name) "-" "_") + (if (string= version "") "" (string-append "-" version)))) + +;; See: https://github.com/hexpm/specifications/blob/master/endpoints.md +(define hexpm (make-parameter "https://repo.hex.pm")) + +(define hexpm-tarballs (string-append (hexpm) "/tarballs/")) (define (hexpm-uri name version) "Return a URI string for the package hosted at hex.pm corresponding to NAME -and VERSION." - (string-append hexpm-package-url name "-" version ".tar")) +and VERSION. -;; -;; Standard build procedure for Erlang packages using Rebar. -;; +XXX: should a warning be emitted? +If NAME is not an Erlang Guix package name, then emit a warning. The download +will fail if it is not correct anyway." -(define %rebar-build-system-modules - ;; Build-side modules imported by default. - `((guix build rebar-build-system) - ,@%gnu-build-system-modules)) + (define (warn-about name) + (format #t "AssertionWarning 4dcbff27 + Assertion: re matches name. + re = ~a + name = ~a +" pkg-name-re name) + + name) -(define (default-rebar3) - "Return the default Rebar3 package." + (define (name->archive-name name) + (if (pkg-name? name) + (string-append (pkg-name->library-directory-name name #:version version) ".tar") + (string-append (warn-about name) "-" version ".tar"))) + + (string-append hexpm-tarballs (name->archive-name name))) + +(define (rebar-default) ;; Lazily resolve the binding to avoid a circular dependency. (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) (module-ref erlang-mod 'rebar3))) -(define (default-erlang) - "Return the default Erlang package." +(define (erlang-default) ;; Lazily resolve the binding to avoid a circular dependency. (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) (module-ref erlang-mod 'erlang))) -(define* (lower name - #:key source inputs native-inputs outputs system target - (rebar (default-rebar3)) - (erlang (default-erlang)) - #:allow-other-keys - #:rest arguments) - "Return a bag for NAME from the given arguments." - (define private-keywords - '(#:target #:rebar #:erlang #:inputs #:native-inputs)) - - (and (not target) ;XXX: no cross-compilation - (bag - (name name) - (system system) - (host-inputs `(,@(if source - `(("source" ,source)) - '()) - ,@inputs)) - (build-inputs `(("rebar" ,rebar) - ("erlang" ,erlang) ;; for escriptize - ,@native-inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - (outputs outputs) - (build rebar-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) - -(define* (rebar-build name inputs - #:key - guile source - (rebar-flags ''("skip_deps=true" "-vv")) - (tests? #t) - (test-target "eunit") - ;; TODO: install-name ; default: based on guix package name - (install-profile "default") - (phases '(@ (guix build rebar-build-system) - %standard-phases)) - (outputs '("out")) - (search-paths '()) - (native-search-paths '()) - (system (%current-system)) - (imported-modules %rebar-build-system-modules) - (modules '((guix build rebar-build-system) - (guix build utils)))) +(define imported-modules + `((guix build rebar-build-system) + ,@%gnu-build-system-modules)) + +(define (input->source input) + "Return a Source associated to the Input INPUT." + (match input + ((name package) + (list (pkg-name->library-directory-name name) + (package-source package))))) + +(define* (rebar-build name + inputs + #:key + guile + source + (rebar-flags ''()) + (tests? #t) + (test-target "eunit") + ;; TODO: install-name ; default: based on guix package name + (install-profile "default") + (phases '(@ (guix build rebar-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (native-search-paths '()) + (system (%current-system)) + (imported-modules imported-modules) + (modules '((guix build rebar-build-system) + (guix build utils))) + (sources-erlang '())) "Build SOURCE with INPUTS." (define builder @@ -122,35 +138,95 @@ (define* (rebar-build name inputs (use-modules #$@(sexp->gexp modules)) #$(with-build-variables inputs outputs + #~(rebar-build #:source #+source - #:system #$system - #:name #$name - #:rebar-flags #$rebar-flags - #:tests? #$tests? - #:test-target #$test-target - ;; TODO: #:install-name #$install-name - #:install-profile #$install-profile - #: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))) + #:sources-erlang '#$sources-erlang + #:system #$system + #:name #$name + #:rebar-flags #$rebar-flags + #:tests? #$tests? + #:test-target #$test-target + ;; TODO: #:install-name #$install-name + #:install-profile #$install-profile + #: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))) + ;; Note: Always pass #:graft? #f. Without it, ALLOWED-REFERENCES & ;; co. would be interpreted as referring to grafted packages. - (gexp->derivation name builder + (gexp->derivation name + builder #:system system #:target #f #:graft? #f #:guile-for-build guile))) +(define* (lower name + #:key + (erlang (erlang-default)) + inputs + native-inputs + outputs + (rebar (rebar-default)) + source + system + target + #:allow-other-keys #:rest arguments) + "Return a bag for NAME from the given arguments." + + (let* ((erlang-packages + (filter (lambda (input) + (match input + ((name _) (pkg-name? name)))) + (append inputs native-inputs))) + + (erlang-sources (map input->source erlang-packages))) + + (define private-keywords + '(#:target #:rebar #:erlang #:inputs #:native-inputs #:sources-erlang)) + + (and (not target) ;XXX: no cross-compilation + (bag (name name) + (system system) + (host-inputs inputs) + (build-inputs `(,@(standard-packages) + ("erlang" ,erlang) + ("rebar" ,rebar) + ,@inputs + ,@native-inputs)) + (outputs outputs) + (build rebar-build) + (arguments (append (list #:sources-erlang erlang-sources) + (strip-keyword-arguments private-keywords + arguments))))))) + (define rebar-build-system - (build-system - (name 'rebar) - (description "The standard Rebar build system") - (lower lower))) + (build-system (name 'rebar) + (description "The standard Rebar build system") + (lower lower))) + + +;;; +;;; Exports +;;; + +(define hexpm-package-url hexpm-tarballs) + +(define %rebar-build-system-modules imported-modules) + + +;;; rebar.scm ends here diff --git a/guix/build/rebar-build-system.scm b/guix/build/rebar-build-system.scm index fb664228..b68348bd 100644 --- a/guix/build/rebar-build-system.scm +++ b/guix/build/rebar-build-system.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Björn Höfling <bjoern.hoefling@bjoernhoefling.de> ;;; Copyright © 2020, 2022 Hartmut Goebel <h.goebel@crazy-compilers.com> +;;; Copyright © 2023 Pierre-Henry Fröhring <phfrohring@deeplinks.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,125 +24,197 @@ (define-module (guix build rebar-build-system) #:use-module ((guix build utils) #:hide (delete)) #:use-module (ice-9 match) #:use-module (ice-9 ftw) + #:use-module (ice-9 string-fun) + #:use-module (ice-9 receive) + #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) - #:export (rebar-build - %standard-phases)) + #:export (rebar-build %standard-phases)) ;; ;; Builder-side code of the standard build procedure for Erlang packages using ;; rebar3. ;; -;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and includedir -;; "(include") need to be configurable +;; Library directory +;; A « library directory » is a directory where Erlang searches for compiled +;; code. Its name should look like: `a_name-1.2.3' where the suffix `-1.2.3' +;; is optional. See: https://www.erlang.org/doc/man/code#code-path. +;; +;; Package name +;; A « package name » is the value of the name field of a package +;; definition. It looks like: `prefix-a-name-1.2.3'. See: +;; https://guix.gnu.org/manual/en/html_node/Package-Naming.html +;; +;; Profile +;; For Rebar3, a « profile » is a name associated to a set of configuration +;; settings overriding or complementing the regular configuration. See: +;; https://rebar3.org/docs/configuration/profiles +;; +;; Source +;; A « source » represents the source code associated to a Guix package as +;; defined by its `source' field. Here, the data sctructure used to +;; represent a source has the form `(list name path)' where `name' is a +;; library directory name and `path' is the store path where to find the +;; source code. +;; +;; Checkout +;; A « checkout » is a locally defined dependency related to a directory +;; managed by rebar. See: +;; https://rebar3.org/docs/configuration/dependencies/#checkout-dependencies -(define %erlang-libdir "/lib/erlang/lib") +(define sep "/") -(define* (erlang-depends #:key inputs #:allow-other-keys) - (define input-directories - (match inputs - (((_ . dir) ...) - dir))) - (mkdir-p "_checkouts") - - (for-each - (lambda (input-dir) - (let ((elibdir (string-append input-dir %erlang-libdir))) - (when (directory-exists? elibdir) - (for-each - (lambda (dirname) - (let ((dest (string-append elibdir "/" dirname)) - (link (string-append "_checkouts/" dirname))) - (when (not (file-exists? link)) - ;; RETHINK: Maybe better copy and make writable to avoid some - ;; error messages e.g. when using with rebar3-git-vsn. - (symlink dest link)))) - (list-directories elibdir))))) - input-directories)) +;; Where Erlang libraries are installed relative to a package path in the store. +(define lib-erlang-lib "lib/erlang/lib") + +(define (list-directories directory) + "Return file names of the sub-directory of DIRECTORY." + (scandir directory + (lambda (file) + (and (not (member file '("." ".."))) + (file-is-directory? (string-append directory sep file)))))) + +(define* (pkg-name->libdir-name name) + "Return the library name deduced from the Erlang package name NAME." + (let* ((suffix (regexp-substitute #f (string-match "^erlang-(.*)" name) 1)) + (elements (string-split suffix #\-))) + (string-append (string-join (drop-right elements 1) "_") "-" (last elements)))) + +(define (libdir-name->prefix name) + "Return the prefix of a library directory name NAME." + (car (string-split name #\-))) + +(define (rebar-build-dir profile) + "Return the path where rebar builds libraries given the profile PROFILE." + (format #f "_build/~a/lib" profile)) + +(define* (pkg-name->build-dir name #:key (profile "default")) + "Return the path of library directory where rebar3 builds code of an Erlang package named NAME given the profile PROFILE." + (string-append (rebar-build-dir profile) sep (libdir-name->prefix (pkg-name->libdir-name name)))) (define* (unpack #:key source #:allow-other-keys) - "Unpack SOURCE in the working directory, and change directory within the -source. When SOURCE is a directory, copy it in a sub-directory of the current -working directory." - (let ((gnu-unpack (assoc-ref gnu:%standard-phases 'unpack))) - (gnu-unpack #:source source) - ;; Packages from hex.pm typically have a contents.tar.gz containing the - ;; actual source. If this tar file exists, extract it. - (when (file-exists? "contents.tar.gz") - (invoke "tar" "xvf" "contents.tar.gz")))) - -(define* (build #:key (rebar-flags '()) #:allow-other-keys) + (if (file-is-directory? source) + ;; If source is a checkout: + (begin + ;; Preserve timestamps (set to the Epoch) on the copied tree so that + ;; things work deterministically. + (copy-recursively source "." #:keep-mtime? #t) + ;; Make the source checkout files writable, for convenience. + (for-each (lambda (f) + (false-if-exception (make-file-writable f))) + (find-files "."))) + + ;; If source is an hex.pm archive: + (begin + (invoke "tar" "xvf" source) + (invoke "tar" "xvf" "contents.tar.gz") + + ;; Prevent an error message during the install phase. + ;; `rebar3 compile' produces symlinks like so in _build/: + ;; priv -> ../../../../priv + ;; include -> ../../../../include + ;; + ;; The install phase copies whatever has been built to the output directory. + ;; If the priv/ directory is absent, then an error `i/o error: + ;; _build/…/priv: No such file or directory' occurs. So, we make sure that a + ;; directory exists. + (for-each (lambda (dir) (mkdir-p dir)) (list "priv" "include"))))) + +(define (configure-HOME . ignored_args) + "In some cases, it is needed for the environment variable HOME to be defined +as a directory with write permission. Examples of errors: + +Could not write to \"/homeless-shelter/.cache/rebar3/hex\". Please ensure the path is writeable. +" + (let ((HOME "HOME") + (tmp "/tmp")) + (setenv HOME tmp) + (format #t "~a=~a\n" HOME tmp))) + +(define* (configure-dependencies #:key + (install-profile "default") + inputs + name + sources-erlang ;List of Source. + version + #:allow-other-keys) + "Rebar3 refuses to compile without network access unless its dependencies are +present as source checkouts. To prevent unnecessary compilations, we must « +pre-install » dependencies in Rebar's build directory." + + ;; If source in sources-erlang, then install it under _checkouts/. + (let ((_checkouts "_checkouts")) + (mkdir-p _checkouts) + + (define (install-source source) + "Install the Source SOURCE in _checkouts." + (match source + ((name path) + (let ((src (string-append _checkouts sep name))) + (mkdir-p src) + (with-directory-excursion src (unpack #:source path)))) + (_ #f))) + + (for-each install-source sources-erlang)) + + ;; If input in inputs is an Erlang package, then install it under _build/. + (let ((_build (format #f "_build/~a/checkouts" install-profile))) + (mkdir-p _build) + + (define (install-libdir elib name dest) + "Install the library directory named NAME from ELIB to DEST." + (let ((src (string-append elib sep name)) + (dest (string-append dest sep (libdir-name->prefix name)))) + (copy-recursively src dest) + (mkdir-p (string-append dest "/priv")))) + + (define (install-all-libdirs dir dest) + "Install in DEST all library directories in DIR." + (let ((elib (string-append dir sep lib-erlang-lib))) + (when (directory-exists? elib) + (for-each (lambda (name) (install-libdir elib name dest)) + (list-directories elib))))) + + (match inputs + (((_ . dirs) ..1) + (for-each + (lambda (dir) (install-all-libdirs dir _build)) + dirs)) + (_ #f)))) + +(define* (build #:key name (rebar-flags '()) #:allow-other-keys) (apply invoke `("rebar3" "compile" ,@rebar-flags))) -(define* (check #:key target (rebar-flags '()) (tests? (not target)) +(define* (check #:key target + (rebar-flags '()) + (tests? (not target)) (test-target "eunit") #:allow-other-keys) (if tests? (apply invoke `("rebar3" ,test-target ,@rebar-flags)) (format #t "test suite not run~%"))) -(define (erlang-package? name) - "Check if NAME correspond to the name of an Erlang package." - (string-prefix? "erlang-" name)) - -(define (package-name-version->erlang-name name+ver) - "Convert the Guix package NAME-VER to the corresponding Erlang name-version -format. Essentially drop the prefix used in Guix and replace dashes by -underscores." - (let* ((name- (package-name->name+version name+ver))) - (string-join - (string-split - (if (erlang-package? name-) ; checks for "erlang-" prefix - (string-drop name- (string-length "erlang-")) - name-) - #\-) - "_"))) - -(define (list-directories directory) - "Return file names of the sub-directory of DIRECTORY." - (scandir directory - (lambda (file) - (and (not (member file '("." ".."))) - (file-is-directory? (string-append directory "/" file)))))) - -(define* (install #:key name outputs - (install-name (package-name-version->erlang-name name)) - (install-profile "default") ; build profile outputs to install - #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (pkg-dir (string-append out %erlang-libdir "/" install-name))) - (let ((bin-dir (string-append "_build/" install-profile "/bin")) - (lib-dir (string-append "_build/" install-profile "/lib"))) - ;; install _build/PROFILE/bin - (when (file-exists? bin-dir) - (copy-recursively bin-dir out #:follow-symlinks? #t)) - ;; install _build/PROFILE/lib/*/{ebin,include,priv} - (for-each - (lambda (*) - (for-each - (lambda (dirname) - (let ((src-dir (string-append lib-dir "/" * "/" dirname)) - (dst-dir (string-append pkg-dir "/" dirname))) - (when (file-exists? src-dir) - (copy-recursively src-dir dst-dir #:follow-symlinks? #t)) - (false-if-exception - (delete-file (string-append dst-dir "/.gitignore"))))) - '("ebin" "include" "priv"))) - (list-directories lib-dir)) - (false-if-exception - (delete-file (string-append pkg-dir "/priv/Run-eunit-loop.expect")))))) +(define* (install #:key name outputs (install-profile "default") #:allow-other-keys) + (let* ((src (pkg-name->build-dir name #:profile install-profile)) + (dest (string-append (assoc-ref outputs "out") + sep lib-erlang-lib sep + (pkg-name->libdir-name name)))) + (mkdir-p dest) + (copy-recursively src dest #:follow-symlinks? #t))) (define %standard-phases (modify-phases gnu:%standard-phases (replace 'unpack unpack) + (add-after 'unpack 'configure-HOME configure-HOME) (delete 'bootstrap) (delete 'configure) - (add-before 'build 'erlang-depends erlang-depends) + (add-before 'build 'configure-dependencies configure-dependencies) (replace 'build build) (replace 'check check) (replace 'install install))) -(define* (rebar-build #:key inputs (phases %standard-phases) - #:allow-other-keys #:rest args) +(define* (rebar-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) "Build the given Erlang package, applying all of PHASES in order." (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; rebar-build-system.scm ends here