guix: java-utils: Add Maven-related phases.

* guix/build/maven/java.scm: New file.
* guix/build/maven/plugin.scm: New file.
* guix/build/maven/pom.scm: New file.
* Makefile.am (MODULES): Add them.
* guix/build-system/ant.scm (%ant-build-system-modules): Add them to the
build side.
* guix/build/java-utils.scm (generate-plugin.xml, install-pom-file)
(install-from-pom): New procedures.

3 files changed, 1067 insertions, 0 deletions

diff --git a/guix/build/maven/java.scm b/guix/build/maven/java.scm
new file mode 100644
index 0000000000..daa4c88045
--- /dev/null
+++ b/guix/build/maven/java.scm
@@ -0,0 +1,147 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019, 2020 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build maven java)
+  #:use-module (ice-9 peg)
+  #:use-module (ice-9 textual-ports)
+  #:export (parse-java-file))
+
+(define-peg-pattern java-file body (and (* WS) (* (and top-level-statement
+                                                       (* WS)))))
+(define-peg-pattern WS none (or " " "\n" "\t" "\r"))
+(define-peg-pattern top-level-statement body (or package import-pat class-pat comment inline-comment))
+(define-peg-pattern package all (and (ignore "package") (* WS) package-name
+                                     (* WS) (ignore ";")))
+(define-peg-pattern import-pat all (and (ignore "import") (* WS)
+                                        (? (and (ignore "static") (* WS)))
+                                        package-name
+                                        (* WS) (ignore ";")))
+(define-peg-pattern comment all (and (? (and annotation-pat (* WS))) (ignore "/*")
+                                     comment-part))
+(define-peg-pattern comment-part body (or (ignore (and (* "*") "/"))
+                                          (and (* "*") (+ comment-chr) comment-part)))
+(define-peg-pattern comment-chr body (or "\t" "\n" (range #\ #\)) (range #\+ #\xffff)))
+(define-peg-pattern inline-comment none (and (ignore "//") (* inline-comment-chr)
+                                            (ignore "\n")))
+(define-peg-pattern inline-comment-chr body (range #\ #\xffff))
+(define-peg-pattern package-name body (* (or (range #\a #\z) (range #\A #\Z)
+                                             (range #\0 #\9) "_" ".")))
+(define-peg-pattern class-pat all (and (? (and annotation-pat (* WS)))
+                                       (* (ignore (or inline-comment comment)))
+                                       (? (and (ignore "private") (* WS)))
+                                       (? (and (ignore "public") (* WS)))
+                                       (? (and (ignore "static") (* WS)))
+                                       (? (and (ignore "final") (* WS)))
+                                       (? (and (ignore "abstract") (* WS)))
+                                       (ignore "class")
+                                       (* WS) package-name (* WS)
+                                       (? extends)
+                                       (? implements)
+                                       (ignore "{") class-body (ignore "}")))
+(define-peg-pattern extends all (? (and (ignore "extends") (* WS)
+                                        package-name (* WS))))
+(define-peg-pattern implements all (? (and (ignore "implements") (* WS)
+                                           package-name (* WS))))
+(define-peg-pattern annotation-pat all (and (ignore "@") package-name
+                                            (? (and
+                                                 (* WS)
+                                                 (ignore "(") (* WS)
+                                                 annotation-attr (* WS)
+                                                 (* (and (ignore ",") (* WS)
+                                                         annotation-attr (* WS)))
+                                                 (ignore ")")))))
+(define-peg-pattern annotation-attr all (or (and attr-name (* WS) (ignore "=")
+                                                 (* WS) attr-value (* WS))
+                                            attr-value))
+(define-peg-pattern attr-name all (* (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9)
+                                         "_")))
+(define-peg-pattern attr-value all (or "true" "false"
+                                       (+ (or (range #\0 #\9) (range #\a #\z)
+                                              (range #\A #\Z) "." "_"))
+                                       array-pat
+                                       string-pat))
+(define-peg-pattern array-pat body
+  (and (ignore "{") (* WS) value
+       (* (and (* WS) "," (* WS) value))
+       (* WS) (ignore "}")))
+(define-peg-pattern string-pat body (and (ignore "\"") (* string-chr) (ignore "\"")))
+(define-peg-pattern string-chr body (or " " "!" (and (ignore "\\") "\"")
+                                        (and (ignore "\\") "\\") (range #\# #\xffff)))
+
+(define-peg-pattern class-body all (and (* WS) (* (and class-statement (* WS)))))
+(define-peg-pattern class-statement body (or inline-comment comment param-pat
+                                             method-pat class-pat))
+(define-peg-pattern param-pat all (and (* (and annotation-pat (* WS)
+                                               (? (ignore inline-comment))
+                                               (* WS)))
+                                       (? (and (ignore (or "private" "public"
+                                                           "protected"))
+                                               (* WS)))
+                                       (? (and (ignore "static") (* WS)))
+                                       (? (and (ignore "volatile") (* WS)))
+                                       (? (and (ignore "final") (* WS)))
+                                       type-name (* WS) param-name
+                                       (? (and (* WS) (ignore "=") (* WS) value))
+                                       (ignore ";")))
+(define-peg-pattern value none (or string-pat (+ valuechr)))
+(define-peg-pattern valuechr none (or comment inline-comment "\n"
+                                      "\t" "\r"
+                                      (range #\  #\:) (range #\< #\xffff)))
+(define-peg-pattern param-name all (* (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9)
+                                          "_")))
+(define-peg-pattern type-name all type-pat)
+(define-peg-pattern type-pat body
+  (or "?"
+      (and (* (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9) "_"))
+           (? "...")
+           (? "[]")
+           (? type-param))))
+(define-peg-pattern type-param body (and "<" (? type-pat)
+                                         (* (and (* WS) "," (* WS) type-pat))
+                                         (* WS) ">"))
+(define-peg-pattern method-pat all (and (* (and annotation-pat (* WS)))
+                                        (? (and (ignore (or "private" "public" "protected"))
+                                                (* WS)))
+                                        (? (and (ignore type-param) (* WS)))
+                                        (? (and (ignore (or "abstract" "final"))
+                                                (* WS)))
+                                        (? (and (ignore "static") (* WS)))
+                                        type-name (* WS) param-name (* WS)
+                                        (ignore "(")
+                                        param-list (ignore ")") (* WS)
+                                        (? (and (ignore "throws") (* WS) package-name (* WS)
+                                                (* (and (ignore ",") (* WS) package-name
+                                                        (* WS)))))
+                                        (or (ignore ";")
+                                            (and (ignore "{") (* WS)
+                                                 (? (and method-statements (* WS)))
+                                            (ignore "}")))))
+(define-peg-pattern param-list all (and (* WS) (* (and (? annotation-pat) (* WS)
+                                                       type-name (* WS)
+                                                       param-name (* WS)
+                                                       (? (ignore ",")) (* WS)))))
+(define-peg-pattern method-statements none (and (or (+ method-chr)
+                                                    (and "{" method-statements "}")
+                                                    string-pat)
+                                                (? method-statements)))
+(define-peg-pattern method-chr none (or "\t" "\n" "\r" " " "!" (range #\# #\z) "|"
+                                        (range #\~ #\xffff)))
+
+
+(define (parse-java-file file)
+  (peg:tree (match-pattern java-file (call-with-input-file file get-string-all))))
diff --git a/guix/build/maven/plugin.scm b/guix/build/maven/plugin.scm
new file mode 100644
index 0000000000..13148ab53c
--- /dev/null
+++ b/guix/build/maven/plugin.scm
@@ -0,0 +1,498 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019, 2020 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build maven plugin)
+  #:use-module (guix build maven java)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:export (generate-mojo-from-files
+	    default-convert-type
+	    maven-convert-type))
+
+(define-record-type mojo
+  (make-mojo package name goal description requires-dependency-collection
+             requires-dependency-resolution requires-direct-invocation?
+             requires-project? requires-reports? aggregator? requires-online?
+             inherited-by-default?  instantiation-strategy execution-strategy
+             since thread-safe? phase parameters components)
+  mojo?
+  (package mojo-package)
+  (name mojo-name)
+  (goal mojo-goal)
+  (description mojo-description)
+  (requires-dependency-collection mojo-requires-dependency-collection)
+  (requires-dependency-resolution mojo-requires-dependency-resolution)
+  (requires-direct-invocation? mojo-requires-direct-invocation?)
+  (requires-project? mojo-requires-project?)
+  (requires-reports? mojo-requires-reports?)
+  (aggregator? mojo-aggregator?)
+  (requires-online? mojo-requires-online?)
+  (inherited-by-default? mojo-inherited-by-default?)
+  (instantiation-strategy mojo-instantiation-strategy)
+  (execution-strategy mojo-execution-strategy)
+  (since mojo-since)
+  (thread-safe? mojo-thread-safe?)
+  (phase mojo-phase)
+  (parameters mojo-parameters)
+  (components mojo-components))
+
+(define* (update-mojo mojo
+           #:key
+           (package (mojo-package mojo))
+           (name (mojo-name mojo))
+           (goal (mojo-goal mojo))
+           (description (mojo-description mojo))
+           (requires-dependency-collection (mojo-requires-dependency-collection mojo))
+           (requires-dependency-resolution (mojo-requires-dependency-resolution mojo))
+           (requires-direct-invocation? (mojo-requires-direct-invocation? mojo))
+           (requires-project? (mojo-requires-project? mojo))
+           (requires-reports? (mojo-requires-reports? mojo))
+           (aggregator? (mojo-aggregator? mojo))
+           (requires-online? (mojo-requires-online? mojo))
+           (inherited-by-default? (mojo-inherited-by-default? mojo))
+           (instantiation-strategy (mojo-instantiation-strategy mojo))
+           (execution-strategy (mojo-execution-strategy mojo))
+           (since (mojo-since mojo))
+           (thread-safe? (mojo-thread-safe? mojo))
+           (phase (mojo-phase mojo))
+           (parameters (mojo-parameters mojo))
+           (components (mojo-components mojo)))
+  (make-mojo package name goal description requires-dependency-collection
+             requires-dependency-resolution requires-direct-invocation?
+             requires-project? requires-reports? aggregator? requires-online?
+             inherited-by-default? instantiation-strategy execution-strategy
+             since thread-safe? phase parameters components))
+
+(define-record-type mojo-parameter
+  (make-mojo-parameter name type since required editable property description
+                       configuration)
+  mojo-parameter?
+  (name          mojo-parameter-name)
+  (type          mojo-parameter-type)
+  (since         mojo-parameter-since)
+  (required      mojo-parameter-required)
+  (editable      mojo-parameter-editable)
+  (property      mojo-parameter-property)
+  (description   mojo-parameter-description)
+  (configuration mojo-parameter-configuration))
+
+(define* (update-mojo-parameter mojo-parameter
+           #:key (name (mojo-parameter-name mojo-parameter))
+                 (type (mojo-parameter-type mojo-parameter))
+                 (since (mojo-parameter-since mojo-parameter))
+                 (required (mojo-parameter-required mojo-parameter))
+                 (editable (mojo-parameter-editable mojo-parameter))
+                 (property (mojo-parameter-property mojo-parameter))
+                 (description (mojo-parameter-description mojo-parameter))
+                 (configuration (mojo-parameter-configuration mojo-parameter)))
+  (make-mojo-parameter name type since required editable property description
+                       configuration))
+
+(define-record-type <mojo-component>
+  (make-mojo-component field role hint)
+  mojo-component?
+  (field mojo-component-field)
+  (role  mojo-component-role)
+  (hint  mojo-component-hint))
+
+(define* (update-mojo-component mojo-component
+           #:key (field (mojo-component-field mojo-component))
+                 (role (mojo-component-role mojo-component))
+                 (hint (mojo-component-hint mojo-component)))
+  (make-mojo-component field role hint))
+
+(define (generate-mojo-parameter mojo-parameter)
+  `(parameter (name ,(mojo-parameter-name mojo-parameter))
+              (type ,(mojo-parameter-type mojo-parameter))
+              ,@(if (mojo-parameter-since mojo-parameter)
+                    `(since (mojo-parameter-since mojo-parameter))
+                    '())
+              (required ,(if (mojo-parameter-required mojo-parameter) "true" "false"))
+              (editable ,(if (mojo-parameter-editable mojo-parameter) "true" "false"))
+              (description ,(mojo-parameter-description mojo-parameter))))
+
+(define (generate-mojo-configuration mojo-parameter)
+  (let ((config (mojo-parameter-configuration mojo-parameter)))
+    (if (or config (mojo-parameter-property mojo-parameter))
+        `(,(string->symbol (mojo-parameter-name mojo-parameter))
+           (@ ,@(cons (list 'implementation (mojo-parameter-type mojo-parameter))
+                      (or config '())))
+          ,@(if (mojo-parameter-property mojo-parameter)
+                (list (string-append "${" (mojo-parameter-property mojo-parameter)
+                                     "}"))
+                '()))
+        #f)))
+
+(define (generate-mojo-component mojo-component)
+  (let ((role (mojo-component-role mojo-component))
+        (field (mojo-component-field mojo-component))
+        (hint (mojo-component-hint mojo-component)))
+    `(requirement
+       (role ,role)
+       ,@(if hint
+          `((role-hint ,hint))
+          '())
+       (field-name ,field))))
+
+(define (generate-mojo mojo)
+  `(mojo
+     (goal ,(mojo-goal mojo))
+     (description ,(mojo-description mojo))
+     ,@(let ((val (mojo-requires-dependency-collection mojo)))
+         (if val
+             `((requiresDependencyCollection ,val))
+             '()))
+     ,@(let ((val (mojo-requires-dependency-resolution mojo)))
+         (if val
+             `((requiresDependencyResolution ,val))
+             '()))
+     ,@(let ((val (mojo-requires-direct-invocation? mojo)))
+         (if val
+             `((requiresDirectInvocation ,val))
+             '()))
+     ,@(let ((val (mojo-requires-project? mojo)))
+         (if val
+             `((requiresProject ,val))
+             '()))
+     ,@(let ((val (mojo-requires-reports? mojo)))
+         (if val
+             `((requiresReports ,val))
+             '()))
+     ,@(let ((val (mojo-aggregator? mojo)))
+         (if val
+             `((aggregator ,val))
+             '()))
+     ,@(let ((val (mojo-requires-online? mojo)))
+         (if val
+             `((requiresOnline ,val))
+             '()))
+     ,@(let ((val (mojo-inherited-by-default? mojo)))
+         (if val
+             `((inheritedByDefault ,val))
+             '()))
+     ,@(let ((phase (mojo-phase mojo)))
+             (if phase
+                 `((phase ,phase))
+                 '()))
+     (implementation ,(string-append (mojo-package mojo) "." (mojo-name mojo)))
+     (language "java")
+     (instantiationStrategy ,(mojo-instantiation-strategy mojo))
+     (executionStrategy ,(mojo-execution-strategy mojo))
+     ,@(let ((since (mojo-since mojo)))
+             (if since
+                 `((since ,since))
+                 '()))
+     ,@(let ((val (mojo-thread-safe? mojo)))
+         (if val
+             `((threadSafe ,val))
+             '()))
+     (parameters
+       ,(map generate-mojo-parameter (mojo-parameters mojo)))
+     (configuration
+       ,@(filter (lambda (a) a) (map generate-mojo-configuration (mojo-parameters mojo))))
+     (requirements
+       ,@(map generate-mojo-component (mojo-components mojo)))))
+
+
+(define (default-convert-type type)
+  (cond
+    ((equal? type "String") "java.lang.String")
+    ((equal? type "String[]") "java.lang.String[]")
+    ((equal? type "File") "java.io.File")
+    ((equal? type "File[]") "java.io.File[]")
+    ((equal? type "List") "java.util.List")
+    ((equal? type "Boolean") "java.lang.Boolean")
+    ((equal? type "Properties") "java.util.Properties")
+    ((and (> (string-length type) 5)
+          (equal? (substring type 0 4) "Map<"))
+     "java.util.Map")
+    ((and (> (string-length type) 6)
+          (equal? (substring type 0 5) "List<"))
+     "java.util.List")
+    ((and (> (string-length type) 15)
+          (equal? (substring type 0 14) "LinkedHashSet<"))
+     "java.util.LinkedHashSet")
+    (else type)))
+
+(define (maven-convert-type type)
+  (cond
+    ((equal? type "MavenProject")
+     "org.apache.maven.project.MavenProject")
+    (else (default-convert-type type))))
+
+(define (update-mojo-from-file mojo file convert-type)
+  (define parse-tree (parse-java-file file))
+
+  (define (update-mojo-from-attrs mojo attrs)
+    (let loop ((mojo mojo) (attrs attrs))
+      (match attrs
+        ('() mojo)
+        ((attr attrs ...)
+         (match attr
+           (('annotation-attr ('attr-name name) ('attr-value value))
+            (cond
+              ((equal? name "name")
+               (loop (update-mojo mojo #:goal value) attrs))
+              ((equal? name "defaultPhase")
+               (let* ((phase (car (reverse (string-split value #\.))))
+                      (phase (string-downcase phase))
+                      (phase (string-join (string-split phase #\_) "-")))
+               (loop (update-mojo mojo #:phase phase) attrs)))
+              ((equal? name "requiresProject")
+               (loop (update-mojo mojo #:requires-project? value) attrs))
+              ((equal? name "threadSafe")
+               (loop (update-mojo mojo #:thread-safe? value) attrs))
+              ((equal? name "aggregator")
+               (loop (update-mojo mojo #:aggregator? value) attrs))
+              ((equal? name "requiresDependencyCollection")
+               (loop
+                 (update-mojo mojo #:requires-dependency-collection
+                              (match value
+                                ("ResolutionScope.COMPILE" "compile")
+                                ("ResolutionScope.COMPILE_PLUS_RUNTIME"
+                                 "compile+runtime")
+                                ("ResolutionScope.RUNTIME" "runtime")
+                                ("ResolutionScope.RUNTIME_PLUS_SYSTEM"
+                                 "runtime+system")
+                                ("ResolutionScope.TEST" "test")
+                                ("ResolutionScope.PROVIDED" "provided")
+                                ("ResolutionScope.SYSTEM" "system")
+                                ("ResolutionScope.IMPORT" "import")))
+                 attrs))
+              ((equal? name "requiresDependencyResolution")
+               (loop
+                 (update-mojo mojo #:requires-dependency-resolution
+                              (match value
+                                ("ResolutionScope.COMPILE" "compile")
+                                ("ResolutionScope.COMPILE_PLUS_RUNTIME"
+                                 "compile+runtime")
+                                ("ResolutionScope.RUNTIME" "runtime")
+                                ("ResolutionScope.RUNTIME_PLUS_SYSTEM"
+                                 "runtime+system")
+                                ("ResolutionScope.TEST" "test")
+                                ("ResolutionScope.PROVIDED" "provided")
+                                ("ResolutionScope.SYSTEM" "system")
+                                ("ResolutionScope.IMPORT" "import")))
+                 attrs))
+              (else
+                (throw 'not-found-attr name))))
+           ((attrs ...) (loop mojo attrs))
+           (_ (loop mojo attrs)))))))
+
+  (define (string->attr name)
+    (define (string-split-upper s)
+      (let ((i (string-index s char-set:upper-case)))
+        (if (and i (> i 0))
+            (cons (substring s 0 i) (string-split-upper (substring s i)))
+            (list s))))
+    (string->symbol
+      (string-join (map string-downcase (string-split-upper name)) "-")))
+
+  (define (update-mojo-parameter-from-attrs mojo-parameter attrs)
+    (match attrs
+      ('() mojo-parameter)
+      (('annotation-attr ('attr-name name) 'attr-value)
+       mojo-parameter)
+       ;(update-mojo-parameter-from-attrs mojo-parameter
+       ;  `(annotation-attr (attr-name ,name) (attr-value ""))))
+      (('annotation-attr ('attr-name name) ('attr-value value))
+       (cond
+         ((equal? name "editable")
+          (update-mojo-parameter mojo-parameter #:editable value))
+         ((equal? name "required")
+          (update-mojo-parameter mojo-parameter #:required value))
+         ((equal? name "property")
+          (update-mojo-parameter mojo-parameter #:property value))
+         (else
+           (update-mojo-parameter mojo-parameter
+                                  #:configuration
+                                  (cons
+                                    (list (string->attr name) value)
+                                    (or
+				      (mojo-parameter-configuration mojo-parameter)
+				      '()))))))
+      ((attr attrs ...)
+       (update-mojo-parameter-from-attrs
+         (update-mojo-parameter-from-attrs mojo-parameter attr)
+         attrs))))
+
+  (define (update-mojo-component-from-attrs mojo-component inverse-import attrs)
+    (match attrs
+      ('() mojo-component)
+      ((attr attrs ...)
+       (match attr
+         (('annotation-attr ('attr-name name) ('attr-value value))
+          (cond
+            ((equal? name "role")
+             (update-mojo-component-from-attrs
+               (update-mojo-component mojo-component
+                 #:role (select-import inverse-import value convert-type))
+               inverse-import
+               attrs))
+            ((equal? name "hint")
+             (update-mojo-component-from-attrs
+               (update-mojo-component mojo-component #:hint value)
+               inverse-import
+               attrs))
+            (else (throw 'not-found-attr name))))
+         ((attrss ...)
+          (update-mojo-component-from-attrs
+            mojo-component inverse-import (append attrss attrs)))))))
+
+  (define (add-mojo-parameter parameters name type last-comment attrs inverse-import)
+    (let loop ((parameters parameters))
+      (match parameters
+        ('() (list (update-mojo-parameter-from-attrs
+                     (make-mojo-parameter
+                       ;; name convert since required editable property comment config
+                       name (select-import inverse-import type convert-type)
+                       #f #f #t #f last-comment #f)
+                     attrs)))
+        ((parameter parameters ...)
+         (if (equal? (mojo-parameter-name parameter) name)
+             (cons (update-mojo-parameter-from-attrs
+                     (make-mojo-parameter
+                       name (select-import inverse-import type convert-type)
+                       #f #f #t #f last-comment #f)
+                     attrs) parameters)
+             (cons parameter (loop parameters)))))))
+
+  (define (update-mojo-from-class-content mojo inverse-import content)
+    (let loop ((content content)
+               (mojo mojo)
+               (last-comment #f))
+      (match content
+        ('() mojo)
+        ((('comment ('annotation-pat _ ...) last-comment) content ...)
+         (loop content mojo last-comment))
+        ((('comment last-comment) content ...)
+         (loop content mojo last-comment))
+        ((('param-pat ('annotation-pat annot-name attrs ...) ('type-name type)
+           ('param-name name)) content ...)
+         (cond
+           ((equal? annot-name "Parameter")
+            (loop content
+                  (update-mojo mojo
+                               #:parameters
+                               (add-mojo-parameter
+                                 (mojo-parameters mojo) name type last-comment
+                                 attrs inverse-import))
+                  #f))
+           ((equal? annot-name "Component")
+            (loop content
+                  (update-mojo mojo
+                               #:components
+                               (cons (update-mojo-component-from-attrs
+                                       (make-mojo-component
+                                         name
+                                         (select-import inverse-import type
+                                                        convert-type)
+                                         #f)
+                                       inverse-import
+                                       attrs)
+                                     (mojo-components mojo)))
+                  #f))
+           (else (throw 'not-found-annot annot-name))))
+        ((('class-pat _ ...) content ...)
+         (loop content mojo #f))
+        ((('param-pat _ ...) content ...)
+         (loop content mojo #f))
+        ((('method-pat _ ...) content ...)
+         (loop content mojo #f)))))
+
+  (define (update-inverse-import inverse-import package)
+    (let ((package-name (car (reverse (string-split package #\.)))))
+      (cons (cons package-name package) inverse-import)))
+
+  (define (select-import inverse-import package convert-type)
+    (let* ((package (car (string-split package #\<)))
+           (package (string-split package #\.))
+           (rest (reverse (cdr package)))
+           (rest (cond
+                   ((null? rest) '())
+                   ((equal? (car rest) "class") (cdr rest))
+                   (else rest)))
+           (base (or (assoc-ref inverse-import (car package)) (car package))))
+      (convert-type (string-join (cons base rest) "."))))
+
+  (let loop ((content parse-tree)
+             (mojo mojo)
+             (inverse-import '())
+             (last-comment #f))
+    (if (null? content)
+        mojo
+        (match content
+          ((tls content ...)
+           (match tls
+             (('package package)
+              (loop content (update-mojo mojo #:package package) inverse-import
+                    last-comment))
+             (('import-pat package)
+              (loop content mojo (update-inverse-import inverse-import package)
+                    last-comment))
+             (('comment last-comment)
+              (loop content mojo inverse-import last-comment))
+             (('class-pat class-tls ...)
+              (let loop2 ((class-tls class-tls) (mojo mojo))
+                (match class-tls
+                  ('() (loop content mojo inverse-import #f))
+                  (((? string? name) class-tls ...)
+                   (loop2 class-tls (update-mojo mojo #:name name)))
+                  ((('annotation-pat annot-name (attrs ...)) class-tls ...)
+                   (loop2
+                     class-tls
+                     (update-mojo-from-attrs mojo attrs)))
+                  ((('class-body class-content ...) class-tls ...)
+                   (loop2
+                     class-tls
+                     (update-mojo-from-class-content
+                       mojo inverse-import class-content)))
+                  ((_ class-tls ...)
+                   (loop2 class-tls mojo)))))
+             (_
+              (loop content mojo inverse-import last-comment))))))))
+
+(define (generate-mojo-from-files convert-type . files)
+  (let ((mojo (make-mojo #f #f #f #f #f #f #f #f #f #f #f #f "per-lookup"
+                         "once-per-session" #f #f #f '() '())))
+    (let loop ((files files) (mojo mojo))
+      (if (null? files)
+          (generate-mojo mojo)
+          (loop
+            (cdr files)
+            (update-mojo-from-file
+              (update-mojo mojo
+                #:package #f
+                #:name #f
+                #:goal #f
+                #:description #f
+                #:requires-dependency-resolution #f
+                #:requires-direct-invocation? #f
+                #:requires-project? #f
+                #:requires-reports? #f
+                #:aggregator? #f
+                #:requires-online? #f
+                #:inherited-by-default? #f
+                #:instantiation-strategy "per-lookup"
+                #:execution-strategy "once-per-session"
+                #:since #f
+                #:thread-safe? #f
+                #:phase #f)
+              (car files)
+	      convert-type))))))
diff --git a/guix/build/maven/pom.scm b/guix/build/maven/pom.scm
new file mode 100644
index 0000000000..aa60af2afa
--- /dev/null
+++ b/guix/build/maven/pom.scm
@@ -0,0 +1,422 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019, 2020 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build maven pom)
+  #:use-module (sxml simple)
+  #:use-module (system foreign)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (get-pom
+            pom-ref
+            pom-description
+            pom-name
+            pom-version
+            pom-artifactid
+            pom-groupid
+            pom-dependencies
+            group->dir
+            fix-pom-dependencies))
+
+(define (get-pom file)
+  "Return the content of a @file{.pom} file."
+  (let ((pom-content (call-with-input-file file xml->sxml)))
+    (match pom-content
+      (('*TOP* _ (_ ('@ _ ...) content ...))
+        content)
+      (('*TOP* (_ ('@ _ ...) content ...))
+       content)
+      (('*TOP* _ (_ content ...))
+        content)
+      (('*TOP* (_ content ...))
+       content))))
+
+(define (pom-ref content attr)
+  "Gets a value associated to @var{attr} in @var{content}, an sxml value that
+represents a @file{.pom} file content, or parts of it."
+  (or
+    (assoc-ref
+      content
+      (string->symbol
+        (string-append "http://maven.apache.org/POM/4.0.0:" attr)))
+    (assoc-ref content (string->symbol attr))))
+
+(define (get-parent content)
+  (pom-ref content "parent"))
+
+(define* (find-parent content inputs #:optional local-packages)
+  "Find the parent pom for the pom file whith @var{content} in a package's
+@var{inputs}.  When the parent pom cannot be found in @var{inputs}, but
+@var{local-packages} is defined, the parent pom is looked up in it.
+
+@var{local-packages} is an association list of groupID to an association list
+of artifactID to version number.
+
+The result is an sxml document that describes the content of the parent pom, or
+of an hypothetical parent pom if it was generated from @var{local-packages}.
+If no result is found, the result is @code{#f}."
+  (let ((parent (pom-ref content "parent")))
+    (if parent
+        (let* ((groupid (car (pom-ref parent "groupId")))
+               (artifactid (car (pom-ref parent "artifactId")))
+               (version (car (pom-ref parent "version")))
+               (pom-file (string-append "lib/m2/" (group->dir groupid)
+                                        "/" artifactid "/" version "/"
+                                        artifactid "-" version ".pom"))
+               (java-inputs (filter
+                              (lambda (input)
+                                (file-exists? (string-append input "/" pom-file)))
+                              inputs))
+               (java-inputs (map (lambda (input) (string-append input "/" pom-file))
+                                 java-inputs)))
+          (if (null? java-inputs)
+              (let ((version (assoc-ref (assoc-ref local-packages groupid) artifactid)))
+                (if version
+                    `((groupId ,groupid)
+                      (artifactId ,artifactid)
+                      (version ,version))
+                    #f))
+              (get-pom (car java-inputs))))
+        #f)))
+
+(define* (pom-groupid content inputs #:optional local-packages)
+  "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))))
+      (cond
+        ((string? res) res)
+        ((null? res) #f)
+        ((list? res) (car res))
+        (else #f)))
+    #f))
+
+(define (pom-artifactid content)
+  "Find the artifactID of a pom file, from its sxml @var{content}."
+  (let ((res (pom-ref content "artifactId")))
+    (if (and res (>= (length res) 1))
+      (car res)
+      #f)))
+
+(define* (pom-version content inputs #:optional local-packages)
+  "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))))
+      (cond
+        ((string? res) res)
+        ((null? res) #f)
+        ((list? res) (car res))
+        (else #f)))
+    #f))
+
+(define (pom-name content)
+  "Return the name of the package as contained in the sxml @var{content} of the
+pom file."
+  (let ((res (pom-ref content "name")))
+    (if (and res (>= (length res) 1))
+      (car res)
+      #f)))
+
+(define (pom-description content)
+  "Return the description of the package as contained in the sxml @var{content}
+of the pom file."
+  (let ((res (pom-ref content "description")))
+    (if (and res (>= (length res) 1))
+      (car res)
+      #f)))
+
+(define (pom-dependencies content)
+  "Return the list of dependencies listed in the sxml @var{content} of the pom
+file."
+  (filter
+    (lambda (a) a)
+    (map
+      (match-lambda
+        ((? string? _) #f)
+        (('http://maven.apache.org/POM/4.0.0:dependency content ...)
+         (let loop ((content content) (groupid #f) (artifactid #f) (version #f) (scope #f))
+           (match content
+             ('()
+              `(dependency
+                 (groupId ,groupid)
+                 (artifactId ,artifactid)
+                 (version ,version)
+                 ,@(if scope `((scope ,scope)) '())))
+             (((? string? _) content ...)
+              (loop content groupid artifactid version scope))
+             ((('http://maven.apache.org/POM/4.0.0:scope scope) content ...)
+              (loop content groupid artifactid version scope))
+             ((('http://maven.apache.org/POM/4.0.0:groupId groupid) content ...)
+              (loop content groupid artifactid version scope))
+             ((('http://maven.apache.org/POM/4.0.0:artifactId artifactid) content ...)
+              (loop content groupid artifactid version scope))
+             ((('http://maven.apache.org/POM/4.0.0:version version) content ...)
+              (loop content groupid artifactid version scope))
+             ((_ content ...)
+              (loop content groupid artifactid version scope))))))
+      (pom-ref content "dependencies"))))
+
+(define version-compare
+  (let ((strverscmp
+         (let ((sym (or (dynamic-func "strverscmp" (dynamic-link))
+                        (error "could not find `strverscmp' (from GNU libc)"))))
+           (pointer->procedure int sym (list '* '*)))))
+    (lambda (a b)
+      "Return '> when A denotes a newer version than B,
+'< when A denotes a older version than B,
+or '= when they denote equal versions."
+      (let ((result (strverscmp (string->pointer a) (string->pointer b))))
+        (cond ((positive? result) '>)
+              ((negative? result) '<)
+              (else '=))))))
+
+(define (version>? a b)
+  "Return #t when A denotes a version strictly newer than B."
+  (eq? '> (version-compare a b)))
+
+(define (fix-maven-xml sxml)
+  "When writing an xml file from an sxml representation, it is not possible to
+use namespaces in tag names.  This procedure takes an @var{sxml} representation
+of a pom file and removes the namespace uses.  It also adds the required bits
+to re-declare the namespaces in the top-level element."
+  (define (fix-xml sxml)
+    (match sxml
+      ((tag ('@ opts ...) rest ...)
+       (if (> (string-length (symbol->string tag))
+              (string-length "http://maven.apache.org/POM/4.0.0:"))
+         (let* ((tag (symbol->string tag))
+                (tag (substring tag (string-length
+                                      "http://maven.apache.org/POM/4.0.0:")))
+                (tag (string->symbol tag)))
+           `(,tag (@ ,@opts) ,@(map fix-xml rest)))
+         `(,tag (@ ,@opts) ,@(map fix-xml rest))))
+      ((tag (rest ...))
+       (if (> (string-length (symbol->string tag))
+              (string-length "http://maven.apache.org/POM/4.0.0:"))
+         (let* ((tag (symbol->string tag))
+                (tag (substring tag (string-length
+                                      "http://maven.apache.org/POM/4.0.0:")))
+                (tag (string->symbol tag)))
+           `(,tag ,@(map fix-xml rest)))
+         `(,tag ,@(map fix-xml rest))))
+      ((tag rest ...)
+       (if (> (string-length (symbol->string tag))
+              (string-length "http://maven.apache.org/POM/4.0.0:"))
+         (let* ((tag (symbol->string tag))
+                (tag (substring tag (string-length
+                                      "http://maven.apache.org/POM/4.0.0:")))
+                (tag (string->symbol tag)))
+           `(,tag ,@(map fix-xml rest)))
+         `(,tag ,@(map fix-xml rest))))
+      (_ sxml)))
+
+  `((*TOP* (*PI* xml "version=\"1.0\" encoding=\"UTF-8\"")
+     (project (@ (xmlns "http://maven.apache.org/POM/4.0.0")
+                 (xmlns:xsi "http://www.w3.org/2001/XMLSchema-instance")
+                 (xmlns:schemaLocation "http://maven.apache.org/POM/4.0.0
+                   http://maven.apache.org/xsd/maven-4.0.0.xsd"))
+       ,(map fix-xml sxml)))))
+
+(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 '()))
+  "Open @var{pom-file}, and override its content, rewritting its dependencies
+to set their version to the latest version available in the @var{inputs}.
+
+@var{#:with-plugins?} controls whether plugins are also overiden.
+@var{#:with-build-dependencies?} controls whether build dependencies (whose
+scope is not empty) are also overiden.  By default build dependencies and
+plugins are not overiden.
+
+@var{#:excludes} is an association list of groupID to a list of artifactIDs.
+When a pair (groupID, artifactID) is present in the list, its entry is
+removed instead of being overiden.  If the entry is ignored because of the
+previous arguments, the entry is not removed.
+
+@var{#:local-packages} is an association list that contains additional version
+information for packages that are not in @var{inputs}.  If the package is
+not found in @var{inputs}, information from this list is used instead to determine
+the latest version of the package.  This is an association list of group IDs
+to another association list of artifact IDs to a version number.
+
+Returns nothing, but overides the @var{pom-file} as a side-effect."
+  (define pom (get-pom pom-file))
+
+  (define (ls dir)
+    (let ((dir (opendir dir)))
+      (let loop ((res '()))
+        (let ((entry (readdir dir)))
+          (if (eof-object? entry)
+              res
+              (loop (cons entry res)))))))
+
+  (define fix-pom
+    (match-lambda
+      ('() '())
+      ((tag rest ...)
+       (match tag
+         (('http://maven.apache.org/POM/4.0.0:dependencies deps ...)
+          `((http://maven.apache.org/POM/4.0.0:dependencies ,(fix-deps deps))
+            ,@(fix-pom rest)))
+         (('http://maven.apache.org/POM/4.0.0:dependencyManagement deps ...)
+          `((http://maven.apache.org/POM/4.0.0:dependencyManagement
+              ,(fix-dep-management deps))
+            ,@(fix-pom rest)))
+         (('http://maven.apache.org/POM/4.0.0:build build ...)
+          (if with-plugins?
+              `((http://maven.apache.org/POM/4.0.0:build ,(fix-build build))
+                ,@(fix-pom rest))
+              (cons tag (fix-pom rest))))
+         (tag (cons tag (fix-pom rest)))))))
+
+  (define fix-dep-management
+    (match-lambda
+      ('() '())
+      ((tag rest ...)
+       (match tag
+         (('http://maven.apache.org/POM/4.0.0:dependencies deps ...)
+          `((http://maven.apache.org/POM/4.0.0:dependencies ,(fix-deps deps #t))
+            ,@(fix-dep-management rest)))
+         (tag (cons tag (fix-dep-management rest)))))))
+
+  (define* (fix-deps deps #:optional optional?)
+    (match deps
+      ('() '())
+      ((tag rest ...)
+       (match tag
+         (('http://maven.apache.org/POM/4.0.0:dependency dep ...)
+          `((http://maven.apache.org/POM/4.0.0:dependency ,(fix-dep dep optional?))
+            ,@(fix-deps rest optional?)))
+         (tag (cons tag (fix-deps rest optional?)))))))
+
+  (define fix-build
+    (match-lambda
+      ('() '())
+      ((tag rest ...)
+       (match tag
+         (('http://maven.apache.org/POM/4.0.0:pluginManagement management ...)
+          `((http://maven.apache.org/POM/4.0.0:pluginManagement
+              ,(fix-management management))
+            ,@(fix-build rest)))
+         (('http://maven.apache.org/POM/4.0.0:plugins plugins ...)
+          `((http://maven.apache.org/POM/4.0.0:plugins
+              ,(fix-plugins plugins))
+            ,@(fix-build rest)))
+         (tag (cons tag (fix-build rest)))))))
+
+  (define fix-management
+    (match-lambda
+      ('() '())
+      ((tag rest ...)
+       (match tag
+         (('http://maven.apache.org/POM/4.0.0:plugins plugins ...)
+          `((http://maven.apache.org/POM/4.0.0:plugins
+              ,(fix-plugins plugins #t))
+            ,@(fix-management rest)))
+         (tag (cons tag (fix-management rest)))))))
+
+  (define* (fix-plugins plugins #:optional optional?)
+    (match plugins
+      ('() '())
+      ((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"))
+                (artifact (pom-artifactid plugin)))
+            (if (member artifact (or (assoc-ref excludes group) '()))
+              (fix-plugins rest optional?)
+              `((http://maven.apache.org/POM/4.0.0:plugin
+                  ,(fix-plugin plugin optional?))
+                ,@(fix-plugins rest optional?)))))
+         (tag (cons tag (fix-plugins rest optional?)))))))
+
+  (define* (fix-plugin plugin #:optional optional?)
+    (let* ((artifact (pom-artifactid plugin))
+           (group (or (pom-groupid plugin inputs) "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)
+        (map
+          (lambda (tag)
+            (match tag
+              (('http://maven.apache.org/POM/4.0.0:version _)
+               `(http://maven.apache.org/POM/4.0.0:version ,version))
+              (('version _)
+               `(http://maven.apache.org/POM/4.0.0:version ,version))
+              (tag tag)))
+          plugin)
+        (cons `(http://maven.apache.org/POM/4.0.0:version ,version) plugin))))
+
+  (define* (fix-dep dep #:optional optional?)
+    (let* ((artifact (pom-artifactid dep))
+           (group (or (pom-groupid dep inputs) (pom-groupid pom inputs)))
+           (scope (pom-ref dep "scope"))
+           (is-optional? (equal? (pom-ref dep "optional") '("true"))))
+      (format (current-error-port) "maven: ~a:~a :: ~a (optional: ~a)~%"
+              group artifact scope optional?)
+      (if (or (and (not (equal? scope '("test"))) (not is-optional?))
+              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)
+              (map
+                (lambda (tag)
+                  (match tag
+                    (('http://maven.apache.org/POM/4.0.0:version _)
+                     `(http://maven.apache.org/POM/4.0.0:version ,version))
+                    (('version _)
+                     `(http://maven.apache.org/POM/4.0.0:version ,version))
+                    (_ tag)))
+                dep)
+              (cons `(http://maven.apache.org/POM/4.0.0:version ,version) dep)))
+          dep)))
+
+  (define* (find-version inputs group artifact #:optional optional?)
+    (let* ((directory (string-append "lib/m2/" (group->dir group)
+                                     "/" artifact))
+           (java-inputs (filter
+                          (lambda (input)
+                            (file-exists? (string-append input "/" directory)))
+                          inputs))
+           (java-inputs (map (lambda (input) (string-append input "/" directory))
+                             java-inputs))
+           (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))))
+
+  (let ((tmpfile (string-append pom-file ".tmp")))
+    (with-output-to-file pom-file
+      (lambda _
+        (sxml->xml (fix-maven-xml (fix-pom pom)))))))