diff options
author | Julien Lepiller <julien@lepiller.eu> | 2021-06-01 00:44:16 +0200 |
---|---|---|
committer | Julien Lepiller <julien@lepiller.eu> | 2021-06-22 13:10:24 +0200 |
commit | 6ec2109ab6ea8c8503288a5729a795939e6db41e (patch) | |
tree | ff486354c1842727c91ca3e857cadf7419ed9f1d /guix/build | |
parent | 573b43c11675a2a125ab8c7d930f32e11f9d3acb (diff) |
guix: maven: Simplify finding local packages and modules.
* 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.
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/maven-build-system.scm | 41 | ||||
-rw-r--r-- | 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 #\.) "/")) |