From e37dcf63dcea0817ffd74722ee5ff2d103aa2157 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 18 Nov 2021 22:32:25 +0100
Subject: build-system/go: Update cross-compilation support to new interface.

* guix/build-system/go.scm (go-cross-build): Remove 'store', 'native-drvs'
and 'target-drvs'; add 'source', 'build-inputs', 'target-inputs', and
'host-inputs'.  Change default value of #:phases.
[builder]: Rewrite as a gexp.
Rewrite body to call 'gexp->derivation' instead of
'build-expression->derivation'.
---
 guix/build-system/go.scm | 116 ++++++++++++++++++++---------------------------
 1 file changed, 48 insertions(+), 68 deletions(-)

(limited to 'guix/build-system')

diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index 8cdcb61028..18824c79d9 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -201,11 +201,11 @@ commit hash and its date rather than a proper release tag."
                       #:system system
                       #:guile-for-build guile)))
 
-(define* (go-cross-build store name
+(define* (go-cross-build name
                          #:key
-                         target native-drvs target-drvs
-                         (phases '(@ (guix build go-build-system)
-                                     %standard-phases))
+                         source target
+                         build-inputs target-inputs host-inputs
+                         (phases '%standard-phases)
                          (outputs '("out"))
                          (search-paths '())
                          (native-search-paths '())
@@ -213,7 +213,7 @@ commit hash and its date rather than a proper release tag."
                          (import-path "")
                          (unpack-path "")
                          (build-flags ''())
-                         (tests? #f) ; nothing can be done
+                         (tests? #f)              ; nothing can be done
                          (allow-go-reference? #f)
                          (system (%current-system))
                          (goarch (first (go-target target)))
@@ -225,73 +225,53 @@ commit hash and its date rather than a proper release tag."
                                     (guix build utils))))
   "Cross-build NAME using GO, where TARGET is a GNU triplet and with INPUTS."
   (define builder
-    `(begin
-       (use-modules ,@modules)
-       (let ()
-         (define %build-host-inputs
-           ',(map (match-lambda
-                    ((name (? derivation? drv) sub ...)
-                     `(,name . ,(apply derivation->output-path drv sub)))
-                    ((name path)
-                     `(,name . ,path)))
-                  native-drvs))
+    #~(begin
+        (use-modules #$@(sexp->gexp modules))
 
-         (define %build-target-inputs
-           ',(map (match-lambda
-                    ((name (? derivation? drv) sub ...)
-                     `(,name . ,(apply derivation->output-path drv sub)))
-                    ((name (? package? pkg) sub ...)
-                     (let ((drv (package-cross-derivation store pkg
-                                                          target system)))
-                       `(,name . ,(apply derivation->output-path drv sub))))
-                    ((name path)
-                     `(,name . ,path)))
-                  target-drvs))
+        (define %build-host-inputs
+          #+(input-tuples->gexp build-inputs))
 
-         (go-build #:name ,name
-                   #:source ,(match (assoc-ref native-drvs "source")
-                                    (((? derivation? source))
-                                     (derivation->output-path source))
-                                    ((source)
-                                     source)
-                                    (source
-                                      source))
-                   #:system ,system
-                   #:phases ,phases
-                   #:outputs %outputs
-                   #:target ,target
-                   #:goarch ,goarch
-                   #:goos ,goos
-                   #:inputs %build-target-inputs
-                   #:native-inputs %build-host-inputs
-                   #:search-paths ',(map search-path-specification->sexp
-                                         search-paths)
-                   #:native-search-paths ',(map
-                                             search-path-specification->sexp
-                                             native-search-paths)
-                   #:install-source? ,install-source?
-                   #:import-path ,import-path
-                   #:unpack-path ,unpack-path
-                   #:build-flags ,build-flags
-                   #:tests? ,tests?
-                   #:allow-go-reference? ,allow-go-reference?
-                   #:inputs %build-inputs))))
+        (define %build-target-inputs
+          (append #$(input-tuples->gexp host-inputs)
+              #+(input-tuples->gexp target-inputs)))
+
+        (define %build-inputs
+          (append %build-host-inputs %build-target-inputs))
 
-    (define guile-for-build
-      (match guile
-             ((? package?)
-              (package-derivation store guile system #:graft? #f))
-             (#f                               ; the default
-              (let* ((distro (resolve-interface '(gnu packages commencement)))
-                     (guile  (module-ref distro 'guile-final)))
-                (package-derivation store guile system #:graft? #f)))))
+        (define %outputs
+          #$(outputs->gexp outputs))
 
-    (build-expression->derivation store name builder
-                                  #:system system
-                                  #:inputs (append native-drvs target-drvs)
-                                  #:outputs outputs
-                                  #:modules imported-modules
-                                  #:guile-for-build guile-for-build))
+        (go-build #:name #$name
+                  #:source #+source
+                  #:system #$system
+                  #:phases #$phases
+                  #:outputs %outputs
+                  #:target #$target
+                  #:goarch #$goarch
+                  #:goos #$goos
+                  #:inputs %build-target-inputs
+                  #:native-inputs %build-host-inputs
+                  #:search-paths '#$(map search-path-specification->sexp
+                                         search-paths)
+                  #:native-search-paths '#$(map
+                                            search-path-specification->sexp
+                                            native-search-paths)
+                  #:install-source? #$install-source?
+                  #:import-path #$import-path
+                  #:unpack-path #$unpack-path
+                  #:build-flags #$build-flags
+                  #:tests? #$tests?
+                  #:allow-go-reference? #$allow-go-reference?
+                  #:inputs %build-inputs)))
+
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    (gexp->derivation name builder
+                      #:system system
+                      #:target target
+                      #:graft? #f
+                      #:substitutable? substitutable?
+                      #:guile-for-build guile)))
 
 (define go-build-system
   (build-system
-- 
cgit v1.2.3