gnu: imapfilter: Use G-expressions.

[jackhill/guix/guix.git] / gnu / ci.scm

diff --git a/gnu/ci.scm b/gnu/ci.scm
index 35fd583..e1ba0f6 100644 (file)
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -21,9 +21,9 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu ci)
-  #:use-module (guix channels)
+  #:use-module (guix build-system channel)
   #:use-module (guix config)
-  #:use-module (guix describe)
+  #:autoload   (guix describe) (package-channels)
   #:use-module (guix store)
   #:use-module (guix grafts)
   #:use-module (guix profiles)
@@ -32,7 +32,6 @@
   #:use-module (guix channels)
   #:use-module (guix config)
   #:use-module (guix derivations)
-  #:use-module (guix build-system)
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix ui)
@@ -41,9 +40,10 @@
   #:use-module ((guix utils) #:select (%current-system))
   #:use-module ((guix scripts system) #:select (read-operating-system))
   #:use-module ((guix scripts pack)
-                #:select (lookup-compressor self-contained-tarball))
+                #:select (self-contained-tarball))
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader u-boot)
+  #:use-module (gnu compression)
   #:use-module (gnu image)
   #:use-module (gnu packages)
   #:use-module (gnu packages gcc)
@@ -55,6 +55,7 @@
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages make-bootstrap)
   #:use-module (gnu packages package-management)
+  #:use-module (guix platform)
   #:use-module (gnu system)
   #:use-module (gnu system image)
   #:use-module (gnu system vm)
@@ -71,8 +72,6 @@
             image->job
 
             %core-packages
-            %cross-targets
-            channel-source->package
 
             arguments->systems
             cuirass-jobs))
@@ -169,17 +168,6 @@ SYSTEM."
       (drop-right %core-packages 6)
       %core-packages))
 
-(define %cross-targets
-  '("mips64el-linux-gnu"
-    "arm-linux-gnueabihf"
-    "aarch64-linux-gnu"
-    "powerpc-linux-gnu"
-    "powerpc64le-linux-gnu"
-    "riscv64-linux-gnu"
-    "i586-pc-gnu"                                 ;aka. GNU/Hurd
-    "i686-w64-mingw32"
-    "x86_64-w64-mingw32"))
-
 (define (cross-jobs store system)
   "Return a list of cross-compilation jobs for SYSTEM."
   (define (from-32-to-64? target)
@@ -221,7 +209,7 @@ SYSTEM."
                                           package target system))
                      (packages-to-cross-build target)))
               (remove (either from-32-to-64? same? pointless?)
-                      %cross-targets)))
+                      (targets))))
 
 (define* (guix-jobs store systems #:key source commit)
   "Return a list of jobs for Guix itself."
@@ -264,77 +252,44 @@ otherwise use the IMAGE name."
          (drv (run-with-store store
                 (mbegin %store-monad
                   (set-guile-for-build (default-guile))
-                  (lower-object (system-image image))))))
+                  (lower-object (system-image image) system)))))
     (parameterize ((%graft? #f))
       (derivation->job name drv))))
 
-(define (image-jobs store system)
+(define* (image-jobs store system
+                     #:key source commit)
   "Return a list of jobs that build images for SYSTEM."
   (define MiB
     (expt 2 20))
 
-  (if (member system %guix-system-supported-systems)
-      `(,(image->job store
-                     (image
-                      (inherit efi-disk-image)
-                      (operating-system installation-os))
-                     #:name "usb-image"
-                     #:system system)
-        ,(image->job
-          store
-          (image
-           (inherit (image-with-label
-                     iso9660-image
-                     (string-append "GUIX_" system "_"
-                                    (if (> (string-length %guix-version) 7)
-                                        (substring %guix-version 0 7)
-                                        %guix-version))))
-           (operating-system installation-os))
-          #:name "iso9660-image"
-          #:system system)
-        ;; Only cross-compile Guix System images from x86_64-linux for now.
-        ,@(if (string=? system "x86_64-linux")
-              (map (cut image->job store <>
-                        #:system system)
-                   %guix-system-images)
-              '()))
-      '()))
-
-(define channel-build-system
-  ;; Build system used to "convert" a channel instance to a package.
-  (let* ((build (lambda* (name inputs
-                               #:key source commit system
-                               #:allow-other-keys)
-                  (mlet* %store-monad ((source (if (string? source)
-                                                   (return source)
-                                                   (lower-object source)))
-                                       (instance
-                                        -> (checkout->channel-instance
-                                            source #:commit commit)))
-                    (channel-instances->derivation (list instance)))))
-         (lower (lambda* (name #:key system source commit
-                               #:allow-other-keys)
-                  (bag
-                    (name name)
-                    (system system)
-                    (build build)
-                    (arguments `(#:source ,source
-                                 #:commit ,commit))))))
-    (build-system (name 'channel)
-                  (description "Turn a channel instance into a package.")
-                  (lower lower))))
-
-(define* (channel-source->package source #:key commit)
-  "Return a package for the given channel SOURCE, a lowerable object."
-  (package
-    (inherit guix)
-    (version (string-append (package-version guix) "+"))
-    (build-system channel-build-system)
-    (arguments `(#:source ,source
-                 #:commit ,commit))
-    (inputs '())
-    (native-inputs '())
-    (propagated-inputs '())))
+  (parameterize ((current-guix-package
+                  (channel-source->package source #:commit commit)))
+    (if (member system %guix-system-supported-systems)
+        `(,(image->job store
+                       (image
+                        (inherit efi-disk-image)
+                        (operating-system installation-os))
+                       #:name "usb-image"
+                       #:system system)
+          ,(image->job
+            store
+            (image
+             (inherit (image-with-label
+                       iso9660-image
+                       (string-append "GUIX_" system "_"
+                                      (if (> (string-length %guix-version) 7)
+                                          (substring %guix-version 0 7)
+                                          %guix-version))))
+             (operating-system installation-os))
+            #:name "iso9660-image"
+            #:system system)
+          ;; Only cross-compile Guix System images from x86_64-linux for now.
+          ,@(if (string=? system "x86_64-linux")
+                (map (cut image->job store <>
+                          #:system system)
+                     %guix-system-images)
+                '()))
+        '())))
 
 (define* (system-test-jobs store system
                            #:key source commit)
@@ -577,7 +532,9 @@ names."
                                hello system))))
          ('images
           ;; Build Guix System images only.
-          (image-jobs store system))
+          (image-jobs store system
+                      #:source source
+                      #:commit commit))
          ('system-tests
           ;; Build Guix System tests only.
           (system-test-jobs store system