guix/build/maven-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix build maven-build-system)
  20   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  21   #:use-module (guix build utils)
  22   #:use-module (guix build maven pom)
  23   #:use-module (ice-9 match)
  24   #:export (%standard-phases
  25             maven-build))
  26
  27 ;; Commentary:
  28 ;;
  29 ;; Builder-side code of the standard maven build procedure.
  30 ;;
  31 ;; Code:
  32
  33 (define* (set-home #:key outputs inputs #:allow-other-keys)
  34   (let ((home (string-append (getcwd) "/build-home")))
  35     (setenv "HOME" home))
  36   (setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
  37   #t)
  38
  39 (define* (configure #:key inputs #:allow-other-keys)
  40   (let* ((m2-files (map
  41                      (lambda (input)
  42                        (match input
  43                          ((name . dir)
  44                           (let ((m2-dir (string-append dir "/lib/m2")))
  45                             (if (file-exists? m2-dir) m2-dir #f)))))
  46                      inputs))
  47          (m2-files (filter (lambda (a) a) m2-files)))
  48     (for-each
  49       (lambda (m2-dir)
  50         (for-each
  51           (lambda (file)
  52             (let ((dir (string-append (getenv "HOME") "/.m2/repository/"
  53                                       (dirname file))))
  54               (mkdir-p dir)
  55               (symlink (string-append m2-dir "/" file)
  56                        (string-append dir "/" (basename file)))))
  57           (with-directory-excursion m2-dir
  58             (find-files "." ".*.(jar|pom)$"))))
  59       m2-files))
  60   (invoke "mvn" "-v")
  61   #t)
  62
  63 (define (add-local-package local-packages group artifact version)
  64   (define (alist-set lst key val)
  65     (match lst
  66       ('() (list (cons key val)))
  67       (((k . v) lst ...)
  68        (if (equal? k key)
  69          (cons (cons key val) lst)
  70          (cons (cons k v) (alist-set lst key val))))))
  71   (alist-set local-packages group
  72     (alist-set (or (assoc-ref local-packages group) '()) artifact
  73       version)))
  74
  75 (define (fix-pom pom-file inputs local-packages excludes)
  76   (chmod pom-file #o644)
  77   (format #t "fixing ~a~%" pom-file)
  78   (fix-pom-dependencies pom-file (map cdr inputs)
  79                         #:with-plugins? #t #:with-build-dependencies? #t
  80                         #:local-packages local-packages
  81                         #:excludes excludes)
  82   (let* ((pom (get-pom pom-file))
  83          (java-inputs (map cdr inputs))
  84          (artifact (pom-artifactid pom))
  85          (group (pom-groupid pom java-inputs local-packages))
  86          (version (pom-version pom java-inputs local-packages)))
  87     (let loop ((modules (pom-ref pom "modules"))
  88                (local-packages
  89                  (add-local-package local-packages group artifact version)))
  90       (pk 'local-packages local-packages)
  91       (match modules
  92         (#f local-packages)
  93         ('() local-packages)
  94         (((? string? _) modules ...)
  95          (loop modules local-packages))
  96         (((_ module) modules ...)
  97          (loop
  98            modules
  99            (fix-pom (string-append (dirname pom-file) "/" module "/pom.xml")
 100                     inputs local-packages excludes)))))))
 101
 102 (define* (fix-pom-files #:key inputs local-packages exclude #:allow-other-keys)
 103   (fix-pom "pom.xml" inputs local-packages exclude))
 104
 105 (define* (build #:key outputs #:allow-other-keys)
 106   "Build the given package."
 107   (invoke "mvn" "package"
 108           ;; offline mode: don't download dependencies
 109           "-o"
 110           ;, set directory where dependencies are installed
 111           (string-append "-Duser.home=" (getenv "HOME")))
 112   #t)
 113
 114 (define* (check #:key tests? #:allow-other-keys)
 115   "Check the given package."
 116   (when tests?
 117     (invoke "mvn" "test"
 118             (string-append "-Duser.home=" (getenv "HOME"))
 119             "-e"))
 120   #t)
 121
 122 (define* (install #:key outputs #:allow-other-keys)
 123   "Install the given package."
 124   (let* ((out (assoc-ref outputs "out"))
 125          (java (string-append out "/lib/m2")))
 126     (invoke "mvn" "install" "-o" "-e"
 127             "-DskipTests"
 128             (string-append "-Duser.home=" (getenv "HOME")))
 129     ;; Go through the repository to find files that can be installed
 130     (with-directory-excursion (string-append (getenv "HOME") "/.m2/repository")
 131       (let ((installable
 132               (filter (lambda (file)
 133                         (not (eq? 'symlink (stat:type (lstat file)))))
 134                       (find-files "." "."))))
 135         (mkdir-p java)
 136         (for-each
 137           (lambda (file)
 138             (mkdir-p (string-append java "/" (dirname file)))
 139             (copy-file file (string-append java "/" file)))
 140           installable)))
 141     ;; Remove some files that are not required and introduce timestamps
 142     (for-each delete-file (find-files out "maven-metadata-local.xml"))
 143     (for-each delete-file (find-files out "_remote.repositories")))
 144   #t)
 145
 146 (define %standard-phases
 147   ;; Everything is as with the GNU Build System except for the `configure'
 148   ;; , `build', `check' and `install' phases.
 149   (modify-phases gnu:%standard-phases
 150     (delete 'bootstrap)
 151     (add-before 'configure 'set-home set-home)
 152     (replace 'configure configure)
 153     (add-after 'configure 'fix-pom-files fix-pom-files)
 154     (replace 'build build)
 155     (replace 'check check)
 156     (replace 'install install)))
 157
 158 (define* (maven-build #:key inputs (phases %standard-phases)
 159                       #:allow-other-keys #:rest args)
 160   "Build the given package, applying all of PHASES in order."
 161   (apply gnu:gnu-build #:inputs inputs #:phases phases args))
 162
 163 ;;; maven-build-system.scm ends here