[bug#74374] [PATCH 2/4] guix: add go module aware build system

["Jørgen Kvalsvik" <j@lambda.is>]

Add a go module aware build system, and make it available through
build-system/go.scm.  The go-mod-build and supporting functions is
largely a copy-and-paste job of the go-build and could probably be
refactored.

The build process when using go modules is slightly different from the
non-module version, and relies on sources already being fetched with
go-mod-fetch.  This revision does not do anything clever with reusing
compiled packages, but it might be possible to store precompiled modules
to the store path without adding explicit entries in golang-*.scm

* guix/build-system/go.scm (%go-mod-build-system-modules): New define.
(mod-lower): New function.
(go-mod-build): New function.
(go-mod-build-system): New function.
* guix/build-system/go-mod-build-system.scm: New file.
* gnu/local.mk: Register it.

Change-Id: I394089073b894e8cf9da5aa18759c939fca45a31
---
 Makefile.am                        |   1 +
 guix/build-system/go.scm           | 120 ++++++++++++++++++++++
 guix/build/go-mod-build-system.scm | 154 +++++++++++++++++++++++++++++
 3 files changed, 275 insertions(+)
 create mode 100644 guix/build/go-mod-build-system.scm

diff --git a/Makefile.am b/Makefile.am
index fc00947f4f..5768b721aa 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -226,6 +226,7 @@ MODULES =					\
   guix/build/minify-build-system.scm		\
   guix/build/font-build-system.scm		\
   guix/build/go-build-system.scm		\
+  guix/build/go-mod-build-system.scm		\
   guix/build/android-repo.scm			\
   guix/build/asdf-build-system.scm		\
   guix/build/bzr.scm				\
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index 226688f2d2..1e60fd9471 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -38,6 +38,8 @@ (define-module (guix build-system go)
   #:export (%go-build-system-modules
             go-build
             go-build-system
+            go-mod-build
+            go-mod-build-system
 
             go-pseudo-version?
             go-target
@@ -117,6 +119,12 @@ (define %go-build-system-modules
     (guix build union)
     ,@%default-gnu-imported-modules))
 
+(define %go-mod-build-system-modules
+  ;; Build-side modules imported and used by default.
+  `((guix build go-mod-build-system)
+    (guix build union)
+    ,@%default-gnu-imported-modules))
+
 (define (default-go)
   ;; Lazily resolve the binding to avoid a circular dependency.
   (let ((go (resolve-interface '(gnu packages golang))))
@@ -181,6 +189,57 @@ (define inputs-with-cache
     (build (if target go-cross-build go-build))
     (arguments (strip-keyword-arguments private-keywords arguments))))
 
+(define* (mod-lower name
+                #:key source inputs native-inputs outputs system target
+                (go (if (supported-package? (default-go))
+                      (default-go)
+                      (default-gccgo)))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:target #:go #:inputs #:native-inputs))
+
+  (define inputs-with-cache
+    ;; XXX: Avoid a circular dependency.  This should be rewritten with
+    ;; 'package-mapping' or similar.
+    (let ((go-std-name (string-append (package-name go) "-std")))
+      (if (string-prefix? go-std-name name)
+          inputs
+          (cons `(,go-std-name ,((make-go-std) go)) inputs))))
+
+  (bag
+    (name name)
+    (system system)
+    (target target)
+    (build-inputs `(,@(if source
+                        `(("source" ,source))
+                        '())
+                     ,@`(("go" ,go))
+                     ,@native-inputs
+                     ,@(if target '() inputs-with-cache)
+                     ,@(if target
+                         ;; Use the standard cross inputs of
+                         ;; 'gnu-build-system'.
+                         (standard-cross-packages target 'host)
+                         '())
+                     ;; Keep the standard inputs of 'gnu-build-system'.
+                     ,@(standard-packages)))
+    (host-inputs (if target inputs-with-cache '()))
+
+    ;; The cross-libc is really a target package, but for bootstrapping
+    ;; reasons, we can't put it in 'host-inputs'.  Namely, 'cross-gcc' is a
+    ;; native package, so it would end up using a "native" variant of
+    ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
+    ;; would use a target variant (built with 'gnu-cross-build'.)
+    (target-inputs (if target
+                     (standard-cross-packages target 'target)
+                     '()))
+
+    (outputs outputs)
+    (build go-mod-build)
+    (arguments (strip-keyword-arguments private-keywords arguments))))
+
 (define* (go-build name inputs
                    #:key
                    source
@@ -310,9 +369,70 @@ (define %outputs
                       #:substitutable? substitutable?
                       #:guile-for-build guile)))
 
+(define* (go-mod-build name inputs
+                   #:key
+                   source
+                   (phases '%standard-phases)
+                   (outputs '("out"))
+                   (search-paths '())
+                   (install-source? #t)
+                   (import-path "")
+                   (unpack-path "")
+                   (build-flags ''())
+                   (tests? #t)
+                   (parallel-build? #t)
+                   (parallel-tests? #t)
+                   (allow-go-reference? #f)
+                   (system (%current-system))
+                   (goarch #f)
+                   (goos #f)
+                   (guile #f)
+                   (imported-modules %go-mod-build-system-modules)
+                   (modules '((guix build go-mod-build-system)
+                              (guix build union)
+                              (guix build utils)))
+                   (substitutable? #t))
+  (define builder
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@modules)
+          (go-build #:name #$name
+                    #:source #+source
+                    #:system #$system
+                    #:phases #$phases
+                    #:outputs #$(outputs->gexp outputs)
+                    #:substitutable? #$substitutable?
+                    #:goarch #$goarch
+                    #:goos #$goos
+                    #:search-paths '#$(sexp->gexp
+                                       (map search-path-specification->sexp
+                                            search-paths))
+                    #:install-source? #$install-source?
+                    #:import-path #$import-path
+                    #:unpack-path #$unpack-path
+                    #:build-flags #$build-flags
+                    #:tests? #$tests?
+                    #:parallel-build? #$parallel-build?
+                    #:parallel-tests? #$parallel-tests?
+                    #:allow-go-reference? #$allow-go-reference?
+                    #:inputs #$(input-tuples->gexp inputs)))))
+
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    (gexp->derivation name builder
+                      #:system system
+                      #:guile-for-build guile)))
+
 (define go-build-system
   (build-system
     (name 'go)
     (description
      "Build system for Go programs")
     (lower lower)))
+
+(define go-mod-build-system
+  (build-system
+    (name 'go)
+    (description
+     "Build system for Go programs, module aware")
+    (lower mod-lower)))
diff --git a/guix/build/go-mod-build-system.scm b/guix/build/go-mod-build-system.scm
new file mode 100644
index 0000000000..80a43a6a60
--- /dev/null
+++ b/guix/build/go-mod-build-system.scm
@@ -0,0 +1,154 @@
+;;; GNU Guix --- Functional package management for GNU
+;;;
+;;; 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 go-mod-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 match)
+  #:export (%standard-phases
+            go-build))
+
+;; Commentary:
+;;
+;; Build procedures for Go packages, using go modules.  This is the
+;; builder-side code.
+;;
+;; Software written in Go is either a 'package' (i.e. library) or 'command'
+;; (i.e. executable).  The module approach is currently heavily biased towards
+;; building executables.
+;;
+;; Unlike the go build system, this builder does not rely on the workspace
+;; or GOPATH, but instead assumes all modules are a part of the input source
+;; (otherwise, go build tries to download it which would fail).  Go projects
+;; rigidly specify dependencies which is handled by the sources being resolved
+;; and downloaded together.  The compiler is fast enough that building
+;; everything from source on a per-package basis is not a great speed loss,
+;; and the benefit from precompiling libraries is reduced by go statically
+;; linking everything anyway.
+;;
+;; TODO:
+;; * Re-use compiled packages
+;;
+;; Code:
+
+(define* (setup-go-environment #:key inputs outputs import-path goos goarch
+                               #:allow-other-keys)
+  "Prepare a Go build environment.  We need to tell go to use the specific
+toolchain even if a module specifies a (slightly) newer one.  We must also
+tell the go build command where to find downloaded packages (go/pkg) and
+where executables (\"commands\") are installed to."
+  (let* ((mod-cache (string-append (getcwd) "/go/pkg"))
+        (src-dir (string-append (getcwd) "/source"))
+        (go-dir (assoc-ref inputs "go"))
+        (out-dir (assoc-ref outputs "out")))
+
+    ;; TODO: Get toolchain from the program itself or package.version, not the
+    ;; store path
+    (setenv "GOTOOLCHAIN" (string-delete #\- (strip-store-file-name go-dir)))
+    (setenv "GOMODCACHE" mod-cache)
+    (setenv "GOCACHE" (string-append (getcwd) "/go/cache"))
+    (setenv "GOBIN" (string-append out-dir "/bin"))
+    (setenv "GO111MODULE" "on")
+    (setenv "GOARCH" (or goarch (getenv "GOHOSTARCH")))
+    (setenv "GOOS" (or goos (getenv "GOHOSTOS")))
+    (match goarch
+      ("arm"
+       (setenv "GOARM" "7"))
+      ((or "mips" "mipsel")
+       (setenv "GOMIPS" "hardfloat"))
+      ((or "mips64" "mips64le")
+       (setenv "GOMIPS64" "hardfloat"))
+      ((or "ppc64" "ppc64le")
+       (setenv "GOPPC64" "power8"))
+      (_ #t))))
+
+(define* (build #:key import-path build-flags (parallel-build? #t)
+                #:allow-other-keys)
+  "Build the package named by IMPORT-PATH."
+  (let* ((njobs (if parallel-build? (parallel-job-count) 1)))
+    (setenv "GOMAXPROCS" (number->string njobs)))
+
+  (with-throw-handler
+    #t
+    (lambda _
+      ;; TODO: This should maybe support list to install multiple commands
+      ;; from the same project in the same package
+      (with-directory-excursion (string-append "source/" import-path)
+        (apply invoke "go" "build"
+               "-v" ; print the name of packages as they are compiled
+               "-x" ; print each command as it is invoked
+               ;; Respectively, strip the symbol table and debug
+               ;; information, and the DWARF symbol table.
+               "-ldflags=-s -w"
+               `(,@build-flags))))
+    (lambda (key . args)
+      (display (string-append "Building '" import-path "' failed.\n"
+                              "Here are the results of `go env`:\n"))
+      (invoke "go" "env"))))
+
+(define* (check #:key tests? import-path (parallel-tests? #t)
+                #:allow-other-keys)
+  "Run the tests for the package named by IMPORT-PATH."
+  (when tests?
+    (let* ((njobs (if parallel-tests? (parallel-job-count) 1)))
+      (setenv "GOMAXPROCS" (number->string njobs)))
+    (with-directory-excursion (string-append "source/" import-path)
+      (invoke "go" "test")))
+  #t)
+
+(define* (install #:key install-source? source outputs import-path
+                  #:allow-other-keys)
+  (with-directory-excursion (string-append "source/" import-path)
+    (display "INSTALLING PROGRAM\n")
+    (invoke "go" "install"
+               "-v" ; print the name of packages as they are compiled
+               "-x" ; print each command as it is invoked
+               ;; Respectively, strip the symbol table and debug
+               ;; information, and the DWARF symbol table.
+               "-ldflags=-s -w"))
+
+  ;; TODO: This is probably less interesting when using the go-mod builder
+  (when install-source?
+    (let* ((out (assoc-ref outputs "out"))
+           (src (string-append source "/source"))
+           (dest (string-append out "/src")))
+      (mkdir-p dest)
+      (copy-recursively src dest #:keep-mtime? #t)))
+  #t)
+
+(define* (install-license-files #:rest args)
+  "Install license files matching LICENSE-FILE-REGEXP to 'share/doc'.  Adjust
+the standard install-license-files phase to first enter the correct directory."
+  (with-directory-excursion "source"
+    (apply (assoc-ref gnu:%standard-phases 'install-license-files) args)))
+
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (delete 'bootstrap)
+    (delete 'configure)
+    (delete 'patch-generated-file-shebangs)
+    (add-before 'build 'setup-go-environment setup-go-environment)
+    (replace 'build build)
+    (replace 'check check)
+    (replace 'install install)
+    (replace 'install-license-files install-license-files)))
+
+(define* (go-build #:key inputs (phases %standard-phases)
+                      #:allow-other-keys #:rest args)
+  "Build the given Go package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
-- 
2.39.5