02/02: Take advantage of the new (guix platform) module

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit fb8353559fc45653c4eaa132e85456b2fbe94342
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu May 26 00:24:55 2022 +0100

    Take advantage of the new (guix platform) module
    
    This means there's less reliance on the hardcoded lists of systems and 
targets
    and mappings between them.
---
 guix-data-service/jobs/load-new-guix-revision.scm | 92 +++++++++++++++++------
 1 file changed, 70 insertions(+), 22 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm 
b/guix-data-service/jobs/load-new-guix-revision.scm
index a14d1f6..d11ab3b 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -353,9 +353,30 @@ WHERE job_id = $1")
                           lock time-spent))
          result)))))
 
+(define (inferior-guix-systems inf)
+  (cond
+   ((inferior-eval
+     '(defined? 'systems
+        (resolve-module '(guix platform)))
+     inf)
+
+    (remove
+     (lambda (system)
+       ;; There aren't currently bootstrap binaries for s390x-linux, so this
+       ;; just leads to lots of errors
+       (string=? system "s390x-linux"))
+     (inferior-eval
+      '((@ (guix platform) systems))
+      inf)))
+
+   (else
+    (inferior-eval
+     '(@ (guix packages) %supported-systems)
+     inf))))
+
 (define (all-inferior-system-tests inf store)
-  (define inferior-%supported-systems
-    (inferior-eval '(@ (guix packages) %supported-systems) inf))
+  (define inf-systems
+    (inferior-guix-systems inf))
 
   (define extract
     `(lambda (store)
@@ -387,7 +408,7 @@ WHERE job_id = $1")
                         system
                         key args)
                        #f)))
-                 (list ,@inferior-%supported-systems))
+                 (list ,@inf-systems))
                 (match (system-test-location system-test)
                   (($ <location> file line column)
                    (list file
@@ -591,24 +612,37 @@ WHERE job_id = $1")
       checkers))))
 
 (define (all-inferior-package-derivations store inf packages)
-  (define inferior-%supported-systems
-    (inferior-eval '(@ (guix packages) %supported-systems) inf))
+  (define inf-systems
+    (inferior-guix-systems inf))
+
+  (define inf-targets
+    (cond
+     ((inferior-eval
+       '(defined? 'targets
+          (resolve-module '(guix platform)))
+       inf)
+      (inferior-eval
+       '((@ (guix platform) targets))
+       inf))
+
+     (else
+      '("arm-linux-gnueabihf"
+        "aarch64-linux-gnu"
+        "mips64el-linux-gnu"
+        "powerpc-linux-gnu"
+        "powerpc64le-linux-gnu"
+        "riscv64-linux-gnu"
+        "i586-pc-gnu"
+        "i686-w64-mingw32"
+        "x86_64-w64-mingw32"))))
 
   (define cross-derivations
-    `(("x86_64-linux" . ("arm-linux-gnueabihf"
-                         "aarch64-linux-gnu"
-                         "mips64el-linux-gnu"
-                         "powerpc-linux-gnu"
-                         "powerpc64le-linux-gnu"
-                         "riscv64-linux-gnu"
-                         "i586-pc-gnu"
-                         "i686-w64-mingw32"
-                         "x86_64-w64-mingw32"))))
+    `(("x86_64-linux" . ,inf-targets)))
 
   (define supported-system-pairs
     (map (lambda (system)
            (cons system #f))
-         inferior-%supported-systems))
+         inf-systems))
 
   (define supported-system-cross-build-pairs
     (append-map
@@ -622,13 +656,22 @@ WHERE job_id = $1")
   (define (proc packages system-target-pairs)
     `(lambda (store)
        (define target-system-alist
-         '(("arm-linux-gnueabihf"   . "armhf-linux")
-           ("aarch64-linux-gnu"     . "aarch64-linux")
-           ("mips64el-linux-gnu"    . "mips64el-linux")
-           ("powerpc-linux-gnu"     . "powerpc-linux")
-           ("powerpc64le-linux-gnu" . "powerpc64le-linux")
-           ("riscv64-linux-gnu"     . "riscv64-linux")
-           ("i586-pc-gnu"           . "i586-gnu")))
+         (if (defined? 'platforms (resolve-module '(guix platform)))
+             (filter-map
+              (lambda (platform)
+                (and
+                 (platform-target platform)
+                 (cons (platform-target platform)
+                       (platform-system platform))))
+              (platforms))
+
+             '(("arm-linux-gnueabihf"   . "armhf-linux")
+               ("aarch64-linux-gnu"     . "aarch64-linux")
+               ("mips64el-linux-gnu"    . "mips64el-linux")
+               ("powerpc-linux-gnu"     . "powerpc-linux")
+               ("powerpc64le-linux-gnu" . "powerpc64le-linux")
+               ("riscv64-linux-gnu"     . "riscv64-linux")
+               ("i586-pc-gnu"           . "i586-gnu"))))
 
        (define 
package-transitive-supported-systems-supports-multiple-arguments? #t)
        (define (get-supported-systems package system)
@@ -749,6 +792,11 @@ WHERE job_id = $1")
                       '()))))))
         (list ,@(map inferior-package-id packages)))))
 
+  (inferior-eval
+   '(when (defined? 'systems (resolve-module '(guix platform)))
+      (use-modules (guix platform)))
+   inf)
+
   (append-map
    (lambda (system-target-pair)
      (format (current-error-port)