From patchwork Wed Nov 8 09:22:35 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Pierre-Henry_Fr=C3=B6hring?= X-Patchwork-Id: 56094 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 5390127BBE9; Wed, 8 Nov 2023 09:27:02 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9B10E27BBEA for ; Wed, 8 Nov 2023 09:26:58 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1r0epN-0000gG-10; Wed, 08 Nov 2023 04:26:25 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1r0epL-0000fd-H7 for guix-patches@gnu.org; Wed, 08 Nov 2023 04:26:23 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1r0epL-0005hS-98 for guix-patches@gnu.org; Wed, 08 Nov 2023 04:26:23 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1r0epx-00031b-M1 for guix-patches@gnu.org; Wed, 08 Nov 2023 04:27:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#66801] [PATCH 1/5] guix: build-system: rebar: build Erlang packages with dependencies. Resent-From: Pierre-Henry =?utf-8?b?RnLDtmhyaW5n?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 08 Nov 2023 09:27:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66801 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 66801@debbugs.gnu.org Cc: Pierre-Henry =?utf-8?b?RnLDtmhyaW5n?= Received: via spool by 66801-submit@debbugs.gnu.org id=B66801.169943557511534 (code B ref 66801); Wed, 08 Nov 2023 09:27:01 +0000 Received: (at 66801) by debbugs.gnu.org; 8 Nov 2023 09:26:15 +0000 Received: from localhost ([127.0.0.1]:44005 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r0epC-0002zx-0c for submit@debbugs.gnu.org; Wed, 08 Nov 2023 04:26:14 -0500 Received: from mail-lf1-x131.google.com ([2a00:1450:4864:20::131]:56769) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r0ep8-0002zM-Qj for 66801@debbugs.gnu.org; Wed, 08 Nov 2023 04:26:12 -0500 Received: by mail-lf1-x131.google.com with SMTP id 2adb3069b0e04-50970c2115eso4369496e87.1 for <66801@debbugs.gnu.org>; Wed, 08 Nov 2023 01:25:32 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=deeplinks-com.20230601.gappssmtp.com; s=20230601; t=1699435526; x=1700040326; darn=debbugs.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=PkYogAIm7PzarS4jP9yOj87GVmsQhgaZBG6YTTv7X4M=; b=UW87H1HbFIowitEC+CWNvSQagjrDromakR00YzB2bQm5hqIyobSjQK/fEvG/J4wctI UJpoLUzCNSkx14Bku42x+6Tb5mUxv1gVWMHp1ptzz9se7xvEpDF3nJ1P/eYC4pgtxU9J nQPXRpyh8H1XGhaS9ayw1gqcw+fmYCj2Vb4vzB3tKbtWQERfVsPHHF6Uc1/4AQXq/j+6 kADWbepktVLJm1KxqILO4p3Ca+CATYlUxkKteX1otFG+II7oTH54GVc2goEsqjrILnrT s6JFr8YwVg4XfHADkZK19F5OYojSe/A3l/lQXgiWCrmfVvob7hhb4kNTMoVfLN/0whLL ek/w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1699435526; x=1700040326; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=PkYogAIm7PzarS4jP9yOj87GVmsQhgaZBG6YTTv7X4M=; b=EEmdKpdflT1/9VBrrQpKTZty//4CLMBPJXUgfyP/JFI73dCIbvtBFokCSRNE1kVuL5 rHsswfy87w2w+sP/SHFOhSRetTcxHIrvnY84ynDjDt0y8VAW1cfays1ErNSdQJFFhgph V4b4JQxJXotacBiB31WWPhpMeJoA2RwVMcrlFiSdZM/o5CGZEaT88Q7RIetOPl5WcgDU W44o3Pme9Pd7bidDzoPmwatKEgLnqZ+mO8aPLAdlyycUD8RMMUXcfwr/0uazMmHAAY5W g58wOn8hMsQArgBMNrtjpoNM1gMnR2AkKM2fdFfcy7xskFNLvcZKOGHos1HE1FoH98ES nPgQ== X-Gm-Message-State: AOJu0YxHPtq0XCyPO0qiNo4lqGnnC8/3F8GZaa2mGKKZ5CETobl9sKFM ZwJbxvSGzc7H/EjDzFwgDtqmdvwl4t8ENIg7VLk= X-Google-Smtp-Source: AGHT+IGMtYLgKdTSPN12DdUN+CUZBOXugn3peyFUj4vZz/pWx2dXo71KIEGKhighBeOvMfN5ynRWng== X-Received: by 2002:a05:6512:e98:b0:507:9ae6:6913 with SMTP id bi24-20020a0565120e9800b005079ae66913mr1021202lfb.28.1699435525906; Wed, 08 Nov 2023 01:25:25 -0800 (PST) Received: from doug.com ([185.244.73.162]) by smtp.gmail.com with ESMTPSA id o8-20020a05600c510800b00407752f5ab6sm18841789wms.6.2023.11.08.01.25.25 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 08 Nov 2023 01:25:25 -0800 (PST) From: Pierre-Henry =?utf-8?b?RnLDtmhyaW5n?= Date: Wed, 8 Nov 2023 10:22:35 +0100 Message-ID: <18844f77e7b742e93525ee1faa48e4808bf32b01.1699434044.git.phfrohring@deeplinks.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Change-Id: Ie221d47fd1c9a766c2e2cdf76460ddfdf65e090d --- 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 ;;; Copyright © 2020 Hartmut Goebel +;;; Copyright © 2023 Pierre-Henry Fröhring ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,20 +19,120 @@ ;;; along with GNU Guix. If not, see . (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)) + + +;;; +;;; 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=?)) + + +;;; +;;; 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)) + +(define (input=? i1 i2) + "Test whether Inputs I1 and I2 are equal." + (string=? (input->name i1) (input->name i2))) + +(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=?))) + + +;;; +;;; 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)))) + + ;;; ;;; 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))) + + (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) + + ;; ;; 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))) + +(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))) + (mkdir-p libdir) + (with-directory-excursion libdir + (unpack #:source archive)))))) + erlang-sources))) (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)