Package: guix-patches;
Reported by: Pierre-Henry Fröhring <phfrohring <at> deeplinks.com>
Date: Sat, 28 Oct 2023 20:21:02 UTC
Severity: normal
Tags: patch
Done: Liliana Marie Prikler <liliana.prikler <at> gmail.com>
Bug is archived. No further changes may be made.
Message #158 received at 66801 <at> debbugs.gnu.org (full text, mbox):
From: Liliana Marie Prikler <liliana.prikler <at> gmail.com> To: Pierre-Henry Fröhring <phfrohring <at> deeplinks.com>, 66801 <at> debbugs.gnu.org Subject: Re: [PATCH 1/5] guix: build-system: rebar: build Erlang packages with dependencies. Date: Wed, 08 Nov 2023 21:40:57 +0100
Am Mittwoch, dem 08.11.2023 um 10:22 +0100 schrieb Pierre-Henry
Fröhring:
> Change-Id: Ie221d47fd1c9a766c2e2cdf76460ddfdf65e090d
> ---
Missing the ChangeLog :)
Also, don't forget to add me to CC so that I can see the changes more
easily.
> guix/build-system/rebar.scm | 223 ++++++++++++++++++++++------
> --
> guix/build/rebar-build-system.scm | 43 +++---
> 2 files changed, 189 insertions(+), 77 deletions(-)
>
> diff --git a/guix/build-system/rebar.scm b/guix/build-
> system/rebar.scm
> index de1294ec..cdff85a6 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 <at> elephly.net>
> ;;; Copyright © 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
> +;;; Copyright © 2023 Pierre-Henry Fröhring
> <phfrohring <at> deeplinks.com>
> ;;;
> ;;; This file is part of GNU Guix.
> ;;;
> @@ -18,20 +19,120 @@
> ;;; 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)
> + #:use-module (guix store)
> + #:use-module (guix utils)
> + #:use-module (srfi srfi-1)
> + #:use-module (srfi srfi-26)
> #:export (hexpm-uri
> hexpm-package-url
> %rebar-build-system-modules
> rebar-build
> rebar-build-system))
>
> +
> +;;;
> +;;; Utils
> +;;;
> +
> +(define (flatten lst) (fold append '() lst))
You use this procedure once and you can probably replace it with
append-map from SRFI-1.
> +;;;
> +;;; Packages
> +;;;
> +
> +(define %erlang-package-prefix "erlang-")
> +
> +(define (erlang-package-name? name)
> + "Indicates if NAME is an Erlang package name.
> +If a package name starts with %erlang-package-prefix, then it is an
> Erlang package name.
> +An Erlang package name must start with %erlang-package-prefix."
> + (string-prefix? %erlang-package-prefix name))
> +
> +(define (hexpm-name pkg-name)
> + "Given a package name PKG-NAME, returns the corresponding hex.pm
> package name."
> + (let ((suffix (string-drop pkg-name (string-length %erlang-
> package-prefix))))
> + (string-replace-substring suffix "-" "_")))
> +
> +(define (all-transitive-inputs pkg pred)
> + "Given a package PKG and a predicate PRED, return all transitive
> inputs of PKG
> +that match the predicate PRED."
> + (delete-duplicates
> + (append
> + (filter pred (package-transitive-inputs pkg))
> + (filter pred (package-transitive-native-inputs pkg))
> + (filter pred (package-transitive-propagated-inputs pkg)))
> + input=?))
We already have package-direct-inputs. Instead of matching labels, you
might want to match package names instead anyway.
> +
> +;;;
> +;;; Input
> +;;;
> +
> +(define (input-mk name package)
> + "Build an Input."
> + (list name package))
> +
> +(define (input->name input)
> + "Return the name of INPUT."
> + (car input))
> +
> +(define (input->package input)
> + "Return the package of INPUT."
> + (cadr input))
You shouldn't define such destructuring procedures. Use (ice-9 match)
where needed.
> +(define (input=? i1 i2)
> + "Test whether Inputs I1 and I2 are equal."
> + (string=? (input->name i1) (input->name i2)))
Yeah, don't compare labels.
> +(define (erlang-input? input)
> + "Test whether INPUT is an Erlang Input."
> + (erlang-package-name? (input->name input)))
> +
> +(define (input->all-inputs input pred)
> + "Return the list of implicit satisfying PRED Inputs associated to
> INPUT, including INPUT."
> + (cons input (all-transitive-inputs (input->package input) pred)))
> +
> +(define (inputs->all-erlang-inputs erlang-inputs)
> + "Return a list of implicit Erlang Inputs associated to INPUT,
> including INPUT."
> + (let ((all-inputs (flatten (map (cut input->all-inputs <> erlang-
> package-name?) erlang-inputs))))
> + (delete-duplicates all-inputs input=?)))
The name, arguments, and docstring of this function do not match in any
way. Consider expressing yourself in terms of known Guile functions.
(define (transitive-erlang-inputs inputs)
(define (erlang-inputs inputs)
(filter-map
(match-lambda ((name package . output)
(and (erlang-package-name?)
(cons* name package output))))
inputs))
(delete-duplicates
(append-map erlang-inputs
(append-map
package-transitive-inputs
(map cadr inputs)))))
Note that there's almost certainly a smarter way than nesting two
append-maps, but am currently too lazy to look that up.
> +
> +;;;
> +;;; Source
> +;;;
> +
> +(define (source-mk name origin)
> + "Build a source.
> +NAME is an hex.pm package name.
> +ORIGIN is an Origin."
> + (list name origin))
> +
> +(define (source->name source)
> + "Return the name of SOURCE."
> + (car source))
> +
> +(define (source->origin source)
> + "Return the origin of SOURCE."
> + (cadr source))
> +
> +(define (source=? s1 s2)
> + "Test whether Sources S1 and S2 are equal."
> + (string=? (source->name s1) (source->name s2)))
> +
> +(define (input->source input)
> + "Given an Input INPUT, return its associated Source."
> + (source-mk (hexpm-name (input->name input))
> + (package-source (input->package input))))
Again, use ice-9 match instead of manually defining all those
destructuring procedures.
> +
> ;;;
> ;;; Definitions for the hex.pm repository,
> ;;;
> @@ -44,10 +145,11 @@ (define %hexpm-repo-url
> (define hexpm-package-url
> (string-append (%hexpm-repo-url) "/tarballs/"))
>
> -(define (hexpm-uri name version)
> +(define (hexpm-uri pkg-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"))
> + (let ((name (if (erlang-package-name? pkg-name) (hexpm-name pkg-
> name) pkg-name)))
> + (string-append hexpm-package-url name "-" version ".tar")))
>
> ;;
> ;; Standard build procedure for Erlang packages using Rebar.
> @@ -78,42 +180,50 @@ (define* (lower name
> #: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)))))
> + '(#:target #:rebar #:erlang #:inputs #:native-inputs #:erlang-
> sources))
> +
> + (let* ((inputs-all (append inputs native-inputs))
> + (erlang-inputs (filter erlang-input? inputs-all))
> + (all-erlang-inputs (inputs->all-erlang-inputs erlang-
> inputs))
> + (all-erlang-sources (map input->source all-erlang-inputs)))
Instead of let-binding these, you might want to define a procedure
(erlang-sources inputs native-inputs) and then use that for #:erlang-
sources.
> + (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
> + ,@inputs
> + ,@native-inputs
> + ;; Keep the standard inputs of 'gnu-
> build-system'.
> + ,@(standard-packages)))
> + (outputs outputs)
> + (build rebar-build)
> + (arguments (append (list #:erlang-sources all-erlang-
> sources)
> + (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))))
> + #: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 '())
> + (erlang-sources '())
> + (system (%current-system))
> + (imported-modules %rebar-build-system-modules)
> + (modules '((guix build rebar-build-system)
> + (guix build utils))))
> "Build SOURCE with INPUTS."
>
> (define builder
> @@ -123,21 +233,22 @@ (define* (rebar-build name inputs
>
> #$(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)))))
> + #: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
> + #:erlang-sources '#$erlang-sources)))))
>
> (mlet %store-monad ((guile (package->derivation (or guile
> (default-guile))
> system #:graft?
> #f)))
> diff --git a/guix/build/rebar-build-system.scm b/guix/build/rebar-
> build-system.scm
> index fb664228..286e4e1a 100644
> --- a/guix/build/rebar-build-system.scm
> +++ b/guix/build/rebar-build-system.scm
> @@ -28,6 +28,13 @@ (define-module (guix build rebar-build-system)
> #:export (rebar-build
> %standard-phases))
>
> +;;
> +;; Utils
> +;;
> +
> +(define sep file-name-separator-string)
How about no?
> +
> ;;
> ;; Builder-side code of the standard build procedure for Erlang
> packages using
> ;; rebar3.
> @@ -37,27 +44,20 @@ (define-module (guix build rebar-build-system)
>
> (define %erlang-libdir "/lib/erlang/lib")
>
> -(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))
> +(define (configure-environment . _)
> + (setenv "REBAR_CACHE_DIR" (getcwd)))
How about simply naming this configure, so that you can use replace
instead of add-after + delete below?
> +(define* (erlang-depends #:key erlang-sources #:allow-other-keys)
> + (let ((checkouts "_checkouts"))
> + (mkdir-p checkouts)
> + (for-each (lambda (source)
> + (match source
> + ((name archive)
> + (let ((libdir (string-append checkouts sep
> name)))
Alternatively add a slash (/) to checkouts ;)
> + (mkdir-p libdir)
> + (with-directory-excursion libdir
> + (unpack #:source archive))))))
> + erlang-sources)))
This loses the previous erlang-depends logic, which unpackaged the
already compiled packages. I really don't think we should have erlang
be yet another rust that heats up the planet compiling leftpad over and
over again. Can we somehow have that cake?
> (define* (unpack #:key source #:allow-other-keys)
> "Unpack SOURCE in the working directory, and change directory
> within the
> @@ -134,6 +134,7 @@ (define* (install #:key name outputs
> (define %standard-phases
> (modify-phases gnu:%standard-phases
> (replace 'unpack unpack)
> + (add-after 'unpack 'configure-environment configure-environment)
> (delete 'bootstrap)
> (delete 'configure)
> (add-before 'build 'erlang-depends erlang-depends)
Cheers
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.