From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id GKHhCv1mtWBWOwAAgWs5BA (envelope-from ) for ; Tue, 01 Jun 2021 00:45:17 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id IMVaBv1mtWDHPwAA1q6Kng (envelope-from ) for ; Mon, 31 May 2021 22:45:17 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id A73B228B91 for ; Tue, 1 Jun 2021 00:45:16 +0200 (CEST) Received: from localhost ([::1]:50876 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lnqep-0006d0-Kn for larch@yhetil.org; Mon, 31 May 2021 18:45:15 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:54674) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lnqed-0006DG-9l for guix-patches@gnu.org; Mon, 31 May 2021 18:45:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:51865) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lnqed-0007TA-2B for guix-patches@gnu.org; Mon, 31 May 2021 18:45:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lnqec-00040M-W0 for guix-patches@gnu.org; Mon, 31 May 2021 18:45:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#48766] [PATCH 03/14] guix: maven: Simplify finding local packages and modules. Resent-From: Julien Lepiller Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 31 May 2021 22:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 48766 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 48766@debbugs.gnu.org Received: via spool by 48766-submit@debbugs.gnu.org id=B48766.162250108815323 (code B ref 48766); Mon, 31 May 2021 22:45:02 +0000 Received: (at 48766) by debbugs.gnu.org; 31 May 2021 22:44:48 +0000 Received: from localhost ([127.0.0.1]:35167 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lnqeN-0003yn-3n for submit@debbugs.gnu.org; Mon, 31 May 2021 18:44:47 -0400 Received: from lepiller.eu ([89.234.186.109]:38956) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lnqeH-0003xU-6F for 48766@debbugs.gnu.org; Mon, 31 May 2021 18:44:41 -0400 Received: from lepiller.eu (localhost [127.0.0.1]) by lepiller.eu (OpenSMTPD) with ESMTP id 15afc781 for <48766@debbugs.gnu.org>; Mon, 31 May 2021 22:44:37 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed; d=lepiller.eu; h=from:to :subject:date:message-id:in-reply-to:references:mime-version :content-transfer-encoding; s=dkim; bh=x9j5kH3FOdCmNm0+E8DBhWJd3 Y3O+O8HgQhlV6PwBMI=; b=TqKECMyNkOV/KiwN59vHxYLQUN89uV7tHk863QcaQ QED0AR/sujxO0pltR91fibxwROIX2nYwIfmvhIn6ymuwzF+kyWRb9I12JjlVIMFO gs1tiR+6ERn9n6/8InJdEgZcEmV3/SvHSwQv7Y29RUuhHgPc4Z5rKy/6WSsVyCc3 nm/S7GOSSZPfd+XbUXnpz4ZOoGRxbiiq+CPfch3sQQkzlKevigrPa3iYJKuQZP/4 eB0u07+ujbehgbR3dZ71o7C/YlNCbPHBGUhJpVoMELBxytt6zYXxwbMHD8sLeuzx s/btw4mvDT/xUXu2/upBtCjvajg6wXe3fyh09ZPSXWhIw== Received: by lepiller.eu (OpenSMTPD) with ESMTPSA id a4e62644 (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256:NO) for <48766@debbugs.gnu.org>; Mon, 31 May 2021 22:44:37 +0000 (UTC) From: Julien Lepiller Date: Tue, 1 Jun 2021 00:44:16 +0200 Message-Id: <20210531224427.13300-3-julien@lepiller.eu> X-Mailer: git-send-email 2.31.1 In-Reply-To: <20210531224427.13300-1-julien@lepiller.eu> References: <20210601004100.69baa2d0@tachikoma.lepiller.eu> <20210531224427.13300-1-julien@lepiller.eu> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit 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+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1622501116; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=xcMGkwTRheTuN9fyMSCIJuLe8mcbex1hpU+AjPSe5uo=; b=dCf7hwhwwyqhVgXupijDaIeRzyCJSe1rTkCRWP4fnIdr56So6mAAYB4g6/z4NJPDHf1+zi VU1M9jH850inFBP42eVlzxLEgjIbTX3h7DB/tWbb0Tob2tkjTYu2SOsY3iVg3YnstcZ/r4 6MHxBBg0dOwhMSK2lTcmXCjQU7PkbwcHEYTiiUvuPMIB0GaYUE/I2waeAjGZsMet1tm8vR wgH1aag1IQvGsran1ttG7UrwAkgtk2StfvZft+yNQS5kWUPQ9QPib+rFsNUGQ0mNpgqAif NEHYWxWGRkzZZAgMlzT3PKCk4ZjP8RbmYrz+6ZEncCZQU7CrAUsOjl4vDfq2uA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1622501116; a=rsa-sha256; cv=none; b=HEUV9TC/xD2/9lRqKFsEaPIrJK0IVBxWGkRdPCkjlGwPHens//QPjlJK3kKMvUWKfsIjA+ WH5Un9sTimMFbKyAcBHrWQwcihJs+e9f/bEXvszGbnNcGEdYCad6xHCYIMTmWGnLDHfcon jroGoWFvheUZbm/Xi9pUJor9ybAQVz5eb+n7eqlc4edsuBk5EAmdvwYrl1kpv4AAcFNPkY WCCV+Rft6EhXIPXinOEY3SoUYQyxlu+875KdWGhpr41LtVwRWREYziDAMAg/zs6+7A+6XN o6B1sGJqCbFldLTRDlXFxg14KIyL+iwXWZZxHvJaIZwbxMrvuaue0RcthbZuag== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=lepiller.eu header.s=dkim header.b=TqKECMyN; dmarc=fail reason="SPF not aligned (relaxed)" header.from=lepiller.eu (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: 3.67 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=lepiller.eu header.s=dkim header.b=TqKECMyN; dmarc=fail reason="SPF not aligned (relaxed)" header.from=lepiller.eu (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: A73B228B91 X-Spam-Score: 3.67 X-Migadu-Scanner: scn0.migadu.com X-TUID: VDFQFa/HboKU * guix/build/maven-build-system (fix-pom): Fix a single pom file without recursing (fix-pom-files): Find local packages and all submodules, and fix them all at once. (add-local-package): Move to... * guix/build/maven/pom.scm (add-local-package): ...here. (pom-and-submodules, pom-local-packages): New procedures. --- guix/build/maven-build-system.scm | 41 +++++------------------- guix/build/maven/pom.scm | 53 ++++++++++++++++++++++++++++++- 2 files changed, 60 insertions(+), 34 deletions(-) diff --git a/guix/build/maven-build-system.scm b/guix/build/maven-build-system.scm index 0456bfdf61..374fa2fdb8 100644 --- a/guix/build/maven-build-system.scm +++ b/guix/build/maven-build-system.scm @@ -60,47 +60,22 @@ (invoke "mvn" "-v") #t) -(define (add-local-package local-packages group artifact version) - (define (alist-set lst key val) - (match lst - ('() (list (cons key val))) - (((k . v) lst ...) - (if (equal? k key) - (cons (cons key val) lst) - (cons (cons k v) (alist-set lst key val)))))) - (alist-set local-packages group - (alist-set (or (assoc-ref local-packages group) '()) artifact - version))) - (define (fix-pom pom-file inputs local-packages excludes) (chmod pom-file #o644) (format #t "fixing ~a~%" pom-file) (fix-pom-dependencies pom-file (map cdr inputs) #:with-plugins? #t #:with-build-dependencies? #t #:local-packages local-packages - #:excludes excludes) - (let* ((pom (get-pom pom-file)) - (java-inputs (map cdr inputs)) - (artifact (pom-artifactid pom)) - (group (pom-groupid pom)) - (version (pom-version pom))) - (let loop ((modules (pom-ref pom "modules")) - (local-packages - (add-local-package local-packages group artifact version))) - (pk 'local-packages local-packages) - (match modules - (#f local-packages) - ('() local-packages) - (((? string? _) modules ...) - (loop modules local-packages)) - (((_ module) modules ...) - (loop - modules - (fix-pom (string-append (dirname pom-file) "/" module "/pom.xml") - inputs local-packages excludes))))))) + #:excludes excludes)) (define* (fix-pom-files #:key inputs local-packages exclude #:allow-other-keys) - (fix-pom "pom.xml" inputs local-packages exclude) + (let ((local-packages (pom-local-packages "pom.xml" #:local-packages local-packages))) + (format (current-error-port) "Fix pom files with local packages: ~a~%" local-packages) + (for-each + (lambda (pom) + (when (file-exists? pom) + (fix-pom pom inputs local-packages exclude))) + (pom-and-submodules "pom.xml"))) #t) (define* (build #:key outputs #:allow-other-keys) diff --git a/guix/build/maven/pom.scm b/guix/build/maven/pom.scm index 327d5f75e8..8f16cf4d26 100644 --- a/guix/build/maven/pom.scm +++ b/guix/build/maven/pom.scm @@ -21,7 +21,8 @@ #:use-module (system foreign) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:export (get-pom + #:export (add-local-package + get-pom pom-ref pom-description pom-name @@ -30,8 +31,24 @@ pom-groupid pom-dependencies group->dir + pom-and-submodules + pom-local-packages fix-pom-dependencies)) +(define (add-local-package local-packages group artifact version) + "Takes @var{local-packages}, a list of local packages, and adds a new one +for @var{group}:@var{artifact} at @var{version}." + (define (alist-set lst key val) + (match lst + ('() (list (cons key val))) + (((k . v) lst ...) + (if (equal? k key) + (cons (cons key val) lst) + (cons (cons k v) (alist-set lst key val)))))) + (alist-set local-packages group + (alist-set (or (assoc-ref local-packages group) '()) artifact + version))) + (define (get-pom file) "Return the content of a @file{.pom} file." (let ((pom-content (call-with-input-file file xml->sxml))) @@ -234,6 +251,40 @@ to re-declare the namespaces in the top-level element." http://maven.apache.org/xsd/maven-4.0.0.xsd")) ,(map fix-xml sxml))))) +(define (pom-and-submodules pom-file) + "Given @var{pom-file}, the file name of a pom, return the list of pom file +names that correspond to itself and its submodules, recursively." + (define (get-modules modules) + (match modules + (#f '()) + ('() '()) + (((? string? _) rest ...) (get-modules rest)) + ((('http://maven.apache.org/POM/4.0.0:module mod) rest ...) + (let ((pom (string-append (dirname pom-file) "/" mod "/pom.xml"))) + (if (file-exists? pom) + (cons pom (get-modules rest)) + (get-modules rest)))))) + + (let* ((pom (get-pom pom-file)) + (modules (get-modules (pom-ref pom "modules")))) + (cons pom-file + (apply append (map pom-and-submodules modules))))) + +(define* (pom-local-packages pom-file #:key (local-packages '())) + "Given @var{pom-file}, a pom file name, return a list of local packages that +this repository contains." + (let loop ((modules (pom-and-submodules pom-file)) + (local-packages local-packages)) + (match modules + (() local-packages) + ((module modules ...) + (let* ((pom (get-pom module)) + (version (pom-version pom)) + (artifactid (pom-artifactid pom)) + (groupid (pom-groupid pom))) + (loop modules + (add-local-package local-packages groupid artifactid version))))))) + (define (group->dir group) "Convert a group ID to a directory path." (string-join (string-split group #\.) "/")) -- 2.31.1