diff options
author | Tobias Geerinckx-Rice <me@tobias.gr> | 2021-06-23 18:45:21 +0200 |
---|---|---|
committer | Tobias Geerinckx-Rice <me@tobias.gr> | 2021-06-23 18:45:21 +0200 |
commit | 9dea3f101f252331c049c03f501398a5ec837ba9 (patch) | |
tree | 61d683a9fae3e147332d07fef207c1ddf51fc301 /guix/build | |
parent | 7f0af119a1e3ea9d0ae53811b619437b3e942702 (diff) | |
parent | 620669fd17306c2edb21c64a99fa47160fefb319 (diff) | |
download | guix-patches-9dea3f101f252331c049c03f501398a5ec837ba9.tar guix-patches-9dea3f101f252331c049c03f501398a5ec837ba9.tar.gz |
Merge branch 'master' into core-updates
Conflicts:
gnu/packages/cups.scm
gnu/packages/python-web.scm
gnu/packages/web.scm
guix/build/maven/pom.scm
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/java-utils.scm | 49 | ||||
-rw-r--r-- | guix/build/maven-build-system.scm | 44 | ||||
-rw-r--r-- | guix/build/maven/pom.scm | 142 | ||||
-rw-r--r-- | guix/build/profiles.scm | 6 |
4 files changed, 169 insertions, 72 deletions
diff --git a/guix/build/java-utils.scm b/guix/build/java-utils.scm index a868e4d52c..87c3ac43c9 100644 --- a/guix/build/java-utils.scm +++ b/guix/build/java-utils.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com> -;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2020, 2021 Julien Lepiller <julien@lepiller.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,6 +28,7 @@ #:use-module (sxml simple) #:export (ant-build-javadoc generate-plugin.xml + generate-pom.xml install-jars install-javadoc install-pom-file @@ -68,9 +69,9 @@ fetched." (let* ((out (assoc-ref outputs "out")) (java-inputs (append (map cdr inputs) (map cdr outputs))) (pom-content (get-pom pom-file)) - (version (pom-version pom-content java-inputs)) + (version (pom-version pom-content)) (artifact (pom-artifactid pom-content)) - (group (group->dir (pom-groupid pom-content java-inputs))) + (group (group->dir (pom-groupid pom-content))) (repository (string-append out "/lib/m2/" group "/" artifact "/" version "/")) (pom-name (string-append repository artifact "-" version ".pom"))) @@ -86,8 +87,8 @@ to ensure that maven can find dependencies." (manifest (string-append dir "/META-INF/MANIFEST.MF")) (pom (get-pom pom-file)) (artifact (pom-artifactid pom)) - (group (pom-groupid pom inputs)) - (version (pom-version pom inputs)) + (group (pom-groupid pom)) + (version (pom-version pom)) (pom-dir (string-append "META-INF/maven/" group "/" artifact))) (mkdir-p (string-append dir "/" pom-dir)) (copy-file pom-file (string-append dir "/" pom-dir "/pom.xml")) @@ -112,9 +113,9 @@ the phase fails." (let* ((out (assoc-ref outputs "out")) (java-inputs (append (map cdr inputs) (map cdr outputs))) (pom-content (get-pom pom-file)) - (version (pom-version pom-content java-inputs)) + (version (pom-version pom-content)) (artifact (pom-artifactid pom-content)) - (group (group->dir (pom-groupid pom-content java-inputs))) + (group (group->dir (pom-groupid pom-content))) (repository (string-append out "/lib/m2/" group "/" artifact "/" version "/")) ;; We try to find the file that was built. If it was built from our @@ -124,7 +125,7 @@ the phase fails." version ".jar")))) ;; Otherwise, we try to find any jar file. (jars (if (null? jars) - (find-files "." ".*.jar") + (find-files "." "\\.jar$") jars)) (jar-name (string-append repository artifact "-" version ".jar")) (pom-name (string-append repository artifact "-" version ".pom"))) @@ -179,9 +180,9 @@ recognize the package as a plugin, and find the entry points in the plugin." (name (pom-name pom-content)) (description (pom-description pom-content)) (dependencies (pom-dependencies pom-content)) - (version (pom-version pom-content java-inputs)) + (version (pom-version pom-content)) (artifact (pom-artifactid pom-content)) - (groupid (pom-groupid pom-content java-inputs)) + (groupid (pom-groupid pom-content)) (mojos `(mojos ,@(with-directory-excursion directory @@ -206,3 +207,31 @@ recognize the package as a plugin, and find the entry points in the plugin." ,mojos (dependencies ,@dependencies))))))))) + +(define* (generate-pom.xml pom-file groupid artifactid version + #:key (dependencies '()) + (name artifactid)) + "Generates the @file{pom.xml} for a project. It is required by Maven to find +a package, and by the java build system to know where to install a package, when +a pom.xml doesn't already exist and installing to the maven repository." + (lambda _ + (mkdir-p (dirname pom-file)) + (with-output-to-file pom-file + (lambda _ + (sxml->xml + (sxml-indent + `(project + (modelVersion "4.0.0") + (name ,name) + (groupId ,groupid) + (artifactId ,artifactid) + (version ,version) + (dependencies + ,@(map + (match-lambda + ((groupid artifactid version) + `(dependency + (groupId ,groupid) + (artifactId ,artifactid) + (version ,version)))) + dependencies))))))))) diff --git a/guix/build/maven-build-system.scm b/guix/build/maven-build-system.scm index 534b4ebcee..b3d97c81ea 100644 --- a/guix/build/maven-build-system.scm +++ b/guix/build/maven-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2020, 2021 Julien Lepiller <julien@lepiller.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -60,47 +60,23 @@ (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 + #:with-modules? #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 java-inputs local-packages)) - (version (pom-version pom java-inputs local-packages))) - (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 dd61f659c2..193a76b7cb 100644 --- a/guix/build/maven/pom.scm +++ b/guix/build/maven/pom.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019, 2020 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2019-2021 Julien Lepiller <julien@lepiller.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -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))) @@ -93,13 +110,12 @@ If no result is found, the result is @code{#f}." (get-pom (car java-inputs)))) #f))) -(define* (pom-groupid content inputs #:optional local-packages) +(define* (pom-groupid content) "Find the groupID of a pom file, potentially looking at its parent pom file. See @code{find-parent} for the meaning of the arguments." (if content (let ((res (or (pom-ref content "groupId") - (pom-groupid (find-parent content inputs local-packages) - inputs)))) + (pom-ref (pom-ref content "parent") "groupId")))) (cond ((string? res) res) ((null? res) #f) @@ -114,13 +130,12 @@ See @code{find-parent} for the meaning of the arguments." (car res) #f))) -(define* (pom-version content inputs #:optional local-packages) +(define* (pom-version content) "Find the version of a pom file, potentially looking at its parent pom file. See @code{find-parent} for the meaning of the arguments." (if content (let ((res (or (pom-ref content "version") - (pom-version (find-parent content inputs local-packages) - inputs)))) + (pom-ref (pom-ref content "parent") "version")))) (cond ((string? res) res) ((null? res) #f) @@ -236,13 +251,48 @@ 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 #\.) "/")) (define* (fix-pom-dependencies pom-file inputs #:key with-plugins? with-build-dependencies? - (excludes '()) (local-packages '())) + with-modules? (excludes '()) + (local-packages '())) "Open @var{pom-file}, and override its content, rewriting its dependencies to set their version to the latest version available in the @var{inputs}. @@ -290,8 +340,24 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." `((http://maven.apache.org/POM/4.0.0:build ,(fix-build build)) ,@(fix-pom rest)) (cons tag (fix-pom rest)))) + (('http://maven.apache.org/POM/4.0.0:modules modules ...) + (if with-modules? + `((http://maven.apache.org/POM/4.0.0:modules ,(fix-modules modules)) + ,@(fix-pom rest)) + (cons tag (fix-pom rest)))) (tag (cons tag (fix-pom rest))))))) + (define fix-modules + (match-lambda + ('() '()) + ((tag rest ...) + (match tag + (('http://maven.apache.org/POM/4.0.0:module module) + (if (file-exists? (string-append (dirname pom-file) "/" module "/pom.xml")) + `((http://maven.apache.org/POM/4.0.0:module ,module) ,@(fix-modules rest)) + (fix-modules rest))) + (tag (cons tag (fix-modules rest))))))) + (define fix-dep-management (match-lambda ('() '()) @@ -325,8 +391,27 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." `((http://maven.apache.org/POM/4.0.0:plugins ,(fix-plugins plugins)) ,@(fix-build rest))) + (('http://maven.apache.org/POM/4.0.0:extensions extensions ...) + `((http://maven.apache.org/POM/4.0.0:extensions + ,(fix-extensions extensions)) + ,@(fix-build rest))) (tag (cons tag (fix-build rest))))))) + (define* (fix-extensions extensions #:optional optional?) + (match extensions + ('() '()) + ((tag rest ...) + (match tag + (('http://maven.apache.org/POM/4.0.0:extension extension ...) + (let ((group (or (pom-groupid extension) "org.apache.maven.plugins")) + (artifact (pom-artifactid extension))) + (if (member artifact (or (assoc-ref excludes group) '())) + (fix-extensions rest optional?) + `((http://maven.apache.org/POM/4.0.0:extension + ,(fix-plugin extension optional?)); extensions are similar to plugins + ,@(fix-extensions rest optional?))))) + (tag (cons tag (fix-extensions rest optional?))))))) + (define fix-management (match-lambda ('() '()) @@ -344,7 +429,7 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." ((tag rest ...) (match tag (('http://maven.apache.org/POM/4.0.0:plugin plugin ...) - (let ((group (or (pom-groupid plugin inputs) "org.apache.maven.plugins")) + (let ((group (or (pom-groupid plugin) "org.apache.maven.plugins")) (artifact (pom-artifactid plugin))) (if (member artifact (or (assoc-ref excludes group) '())) (fix-plugins rest optional?) @@ -355,11 +440,11 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." (define* (fix-plugin plugin #:optional optional?) (let* ((artifact (pom-artifactid plugin)) - (group (or (pom-groupid plugin inputs) "org.apache.maven.plugins")) + (group (or (pom-groupid plugin) "org.apache.maven.plugins")) (version (or (assoc-ref (assoc-ref local-packages group) artifact) (find-version inputs group artifact optional?) - (pom-version plugin inputs)))) - (if (pom-version plugin inputs) + (pom-version plugin)))) + (if (pom-version plugin) (map (lambda (tag) (match tag @@ -373,7 +458,7 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." (define* (fix-dep dep #:optional optional?) (let* ((artifact (pom-artifactid dep)) - (group (or (pom-groupid dep inputs) (pom-groupid pom inputs))) + (group (or (pom-groupid dep) (pom-groupid pom))) (scope (pom-ref dep "scope")) (is-optional? (equal? (pom-ref dep "optional") '("true")))) (format (current-error-port) "maven: ~a:~a :: ~a (optional: ~a)~%" @@ -382,8 +467,8 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." with-build-dependencies?) (let ((version (or (assoc-ref (assoc-ref local-packages group) artifact) (find-version inputs group artifact optional?) - (pom-version dep inputs)))) - (if (pom-version dep inputs) + (pom-version dep)))) + (if (pom-version dep) (map (lambda (tag) (match tag @@ -396,7 +481,7 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." (cons `(http://maven.apache.org/POM/4.0.0:version ,version) dep))) dep))) - (define* (find-version inputs group artifact #:optional optional?) + (define (find-packaged-version inputs group artifact) (let* ((directory (string-append "lib/m2/" (group->dir group) "/" artifact)) (java-inputs (filter @@ -408,15 +493,22 @@ Returns nothing, but overrides the @var{pom-file} as a side-effect." (versions (append-map ls java-inputs)) (versions (sort versions version>?))) (if (null? versions) - (if optional? #f - (begin - (format (current-error-port) "maven: ~a:~a is missing from inputs~%" - group artifact) - (throw 'no-such-input group artifact))) - (car versions)))) + (car versions)))) + + (define* (find-version inputs group artifact #:optional optional?) + (let ((packaged-version (find-packaged-version inputs group artifact)) + (local-version (assoc-ref (assoc-ref local-packages group) artifact))) + (or local-version packaged-version + (if optional? + #f + (begin + (format (current-error-port) "maven: ~a:~a is missing from inputs~%" + group artifact) + (throw 'no-such-input group artifact)))))) (let ((tmpfile (string-append pom-file ".tmp"))) - (with-output-to-file pom-file + (with-output-to-file tmpfile (lambda _ - (sxml->xml (fix-maven-xml (fix-pom pom))))))) + (sxml->xml (fix-maven-xml (fix-pom pom))))) + (rename-file tmpfile pom-file))) diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index 9249977bed..f9875ca92e 100644 --- a/guix/build/profiles.scm +++ b/guix/build/profiles.scm @@ -159,15 +159,15 @@ search path specifications." (((name version output item ('propagated-inputs deps) ('search-paths paths) _ ...) . rest) - (loop (append deps rest) + (loop (append rest deps) ;breadth-first traversal (cons item inputs) (append paths search-paths))) (() - (values inputs + (values (reverse inputs) (delete-duplicates (cons $PATH (map sexp->search-path-specification - search-paths)))))))))) + (reverse search-paths))))))))))) (define* (build-profile output manifest #:key (extra-inputs '()) (symlink symlink)) |