ci: Add missing include.

* gnu/ci.scm: Add missing include.
ci: Backport package-channels procedure.
2026-07-10 03:14:07 +02:00 · 2021-06-14 10:13:40 +02:00 · 2021-06-14 10:08:49 +02:00 · 2021-06-14 09:09:25 +02:00 · 2021-06-14 09:03:26 +02:00 · 2021-04-02 11:09:06 +02:00
4 changed files with 315 additions and 288 deletions
@@ -182,32 +182,6 @@ as well as images, OS examples, and translations."
    "-c" "EXTRA_HEAD=<meta name=\"viewport\" \
 content=\"width=device-width, initial-scale=1\" />"))
 (define guile-lib/htmlprag-fixed
  ;; Guile-Lib with a hotfix for (htmlprag).
  (package
    (inherit guile-lib)
    (arguments
     (substitute-keyword-arguments (package-arguments guile-lib)
       ((#:phases phases '%standard-phases)
        `(modify-phases ,phases
           (add-before 'build 'fix-htmlprag
             (lambda _
               ;; When parsing
               ;; "<body><blockquote><p>foo</p>\n</blockquote></body>",
               ;; 'html->shtml' would mistakenly close 'blockquote' right
               ;; before <p>.  This patch removes 'p' from the
               ;; 'parent-constraints' alist to fix that.
               (substitute* "src/htmlprag.scm"
                 (("^[[:blank:]]*\\(p[[:blank:]]+\\. \\(body td th\\)\\).*")
                  ""))
               #t))
           (add-before 'check 'skip-known-failure
             (lambda _
               ;; XXX: The above change causes one test failure among
               ;; the htmlprag tests.
               (setenv "XFAIL_TESTS" "htmlprag.scm")
               #t))))))))
 (define (normalize-language-code language)        ;XXX: deduplicate
  ;; Normalize LANGUAGE.  For instance, "zh_CN" becomes "zh-cn".
  (string-map (match-lambda
@@ -224,7 +198,7 @@ key is an identifier and the associated value is the URL reference pointing to
 that identifier.  The URL is constructed by concatenating BASE-URL to the
 actual file name."
  (define build
-    (with-extensions (list guile-lib/htmlprag-fixed)
+    (with-extensions (list guile-lib)
      (with-imported-modules '((guix build utils))
        #~(begin
            (use-modules (guix build utils)
@@ -236,6 +210,8 @@ actual file name."
                         (ice-9 threads)
                         (ice-9 pretty-print))
            (%strict-tokenizer? #t)
            (define file-url
              (let ((prefix (string-append #$manual "/")))
                (lambda (file)
@@ -380,7 +356,7 @@ actual file name."
 to (1) add them a link to SYNTAX-CSS-URL, and (2) highlight the syntax of all
 its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
  (define build
-    (with-extensions (list guile-lib/htmlprag-fixed guile-syntax-highlight)
+    (with-extensions (list guile-lib guile-syntax-highlight)
      (with-imported-modules '((guix build utils))
        #~(begin
            (use-modules (htmlprag)
@@ -394,6 +370,8 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
                         (ice-9 threads)
                         (ice-9 vlist))
            (%strict-tokenizer? #t)
            (define (pair-open/close lst)
              ;; Pair 'open' and 'close' tags produced by 'highlights' and
              ;; produce nested 'paren' tags instead.
@@ -2751,7 +2751,7 @@ the command prints and, similar to what we saw above, paste these two
 lines in your terminal and @file{.bash_profile}:
@example
-GUIX_PROFILE="$HOME/.config/guix/current/etc/profile"
+GUIX_PROFILE="$HOME/.config/guix/current"
 . "$GUIX_PROFILE/etc/profile"
@end example
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,7 +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 config)
  #:use-module (guix describe)
  #:use-module (guix store)
  #:use-module (guix grafts)
  #:use-module (guix profiles)
@@ -34,7 +37,8 @@
  #:use-module (guix ui)
  #:use-module ((guix licenses)
                #:select (gpl3+ license? license-name))
-  #:use-module ((guix utils) #:select (%current-system))
+  #:use-module ((guix utils) #:select (%current-system
                                       location-file))
  #:use-module ((guix scripts system) #:select (read-operating-system))
  #:use-module ((guix scripts pack)
                #:select (lookup-compressor self-contained-tarball))
@@ -61,67 +65,123 @@
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
-  #:export (%cross-targets
+  #:export (derivation->job
            image->job
            %core-packages
            %cross-targets
            channel-source->package
-            hydra-jobs))
+
            arguments->systems
            cuirass-jobs))
 ;;; Commentary:
 ;;;
-;;; This file defines build jobs for the Hydra and Cuirass continuation
+;;; This file defines build jobs for Cuirass.
 ;;; integration tools.
 ;;;
 ;;; Code:
-(define* (package->alist store package system
+;; Backport from (guix channels) module.
-                         #:optional (package-derivation package-derivation))
+(define* (sexp->channel sexp #:optional (name 'channel))
-  "Convert PACKAGE to an alist suitable for Hydra."
+  "Read SEXP, a provenance sexp as created by 'channel-instance->sexp'; use
-  (parameterize ((%graft? #f))
+NAME as the channel name if SEXP does not specify it.  Return #f if the sexp
-    (let ((drv (package-derivation store package system
+does not have the expected structure."
-                                   #:graft? #f)))
+  (match sexp
-      `((derivation . ,(derivation-file-name drv))
+    (('repository ('version 0)
-        (log . ,(log-file store (derivation-file-name drv)))
+                  ('url url)
-        (outputs . ,(filter-map (lambda (res)
+                  ('branch branch)
-                                  (match res
+                  ('commit commit)
-                                    ((name . path)
+                  rest ...)
-                                     `(,name . ,path))))
+     ;; Historically channel sexps did not include the channel name.  It's OK
-                                (derivation->output-paths drv)))
+     ;; for channels created by 'channel-instances->manifest' because the
-        (nix-name . ,(derivation-name drv))
+     ;; entry name is the channel name, but it was missing for entries created
-        (system . ,(derivation-system drv))
+     ;; by 'manifest-entry-with-provenance'.
-        (description . ,(package-synopsis package))
+     (channel (name (match (assq 'name rest)
-        (long-description . ,(package-description package))
+                      (#f name)
                      (('name name) name)))
              (url url)
              (branch branch)
              (commit commit)
              (introduction
               (match (assq 'introduction rest)
                 (#f #f)
                 (('introduction intro)
                  (sexp->channel-introduction intro))))))
-        ;; XXX: Hydra ignores licenses that are not a <license> structure or a
+    (_ #f)))
        ;; list thereof.
        (license . ,(let loop ((license (package-license package)))
                      (match license
                        ((? license?)
                         (license-name license))
                        ((lst ...)
                         (map loop license)))))
-        (home-page . ,(package-home-page package))
+;; Backport from (guix describe) module.
-        (maintainers . ("bug-guix@gnu.org"))
+(define (package-channels package)
-        (max-silent-time . ,(or (assoc-ref (package-properties package)
+  "Return the list of channels providing PACKAGE or an empty list if it could
-                                           'max-silent-time)
+not be determined."
-                                3600))              ;1 hour by default
+  (match (and=> (package-location package) location-file)
-        (timeout . ,(or (assoc-ref (package-properties package) 'timeout)
+    (#f '())
-                        72000))))))                  ;20 hours by default
+    (file
     (let ((file (if (string-prefix? "/" file)
                     file
                     (search-path %load-path file))))
       (if (and file
                (string-prefix? (%store-prefix) file))
           (filter-map
            (lambda (entry)
              (let ((item (manifest-entry-item entry)))
                (and (or (string-prefix? item file)
                         (string=? "guix" (manifest-entry-name entry)))
                     (manifest-entry-channel entry))))
            (current-profile-entries))
           '())))))
-(define (package-job store job-name package system)
+(define* (derivation->job name drv
                          #:key
                          (max-silent-time 3600)
                          (timeout 3600))
  "Return a Cuirass job called NAME and describing DRV.
 MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when
 building the derivation."
  `((#:job-name . ,name)
    (#:derivation . ,(derivation-file-name drv))
    (#:inputs . ,(map (compose derivation-file-name
                               derivation-input-derivation)
                      (derivation-inputs drv)))
    (#:outputs . ,(filter-map
                   (lambda (res)
                     (match res
                       ((name . path)
                        `(,name . ,path))))
                   (derivation->output-paths drv)))
    (#:nix-name . ,(derivation-name drv))
    (#:system . ,(derivation-system drv))
    (#:max-silent-time . ,max-silent-time)
    (#:timeout . ,timeout)))
 (define* (package-job store job-name package system
                      #:key cross? target)
  "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
-  (let ((job-name (symbol-append job-name (string->symbol ".")
+  (let ((job-name (string-append job-name "." system)))
-                                 (string->symbol system))))
+    (parameterize ((%graft? #f))
-    `(,job-name . ,(cut package->alist store package system))))
+      (let* ((drv (if cross?
                      (package-cross-derivation store package target system
                                                #:graft? #f)
                      (package-derivation store package system
                                          #:graft? #f)))
             (max-silent-time (or (assoc-ref (package-properties package)
                                             'max-silent-time)
                                  3600))
             (timeout (or (assoc-ref (package-properties package)
                                     'timeout)
                          72000)))
        (derivation->job job-name drv
                         #:max-silent-time max-silent-time
                         #:timeout timeout)))))
 (define (package-cross-job store job-name package target system)
  "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on
 SYSTEM."
-  `(,(symbol-append (string->symbol target) (string->symbol ".") job-name
+  (let ((name (string-append target "." job-name "." system)))
-                    (string->symbol ".") (string->symbol system)) .
+    (package-job store name package system
-    ,(cute package->alist store package system
+                 #:cross? #t
-           (lambda* (store package system #:key graft?)
+                 #:target target)))
             (package-cross-derivation store package target system
                                       #:graft? graft?)))))
 (define %core-packages
  ;; Note: Don't put the '-final' package variants because (1) that's
@@ -149,6 +209,7 @@ SYSTEM."
    "arm-linux-gnueabihf"
    "aarch64-linux-gnu"
    "powerpc-linux-gnu"
    "powerpc64le-linux-gnu"
    "riscv64-linux-gnu"
    "i586-pc-gnu"                                 ;aka. GNU/Hurd
    "i686-w64-mingw32"
@@ -197,6 +258,22 @@ SYSTEM."
              (remove (either from-32-to-64? same? pointless?)
                      %cross-targets)))
 (define* (guix-jobs store systems #:key source commit)
  "Return a list of jobs for Guix itself."
  (define build
    (primitive-load (string-append source "/build-aux/build-self.scm")))
  (map
   (lambda (system)
     (let ((name (string->symbol
                  (string-append "guix." system)))
           (drv (run-with-store store
                  (build source #:version commit #:system system
                         #:pull-version 1
                         #:guile-version "2.2"))))
       (derivation->job name drv)))
   systems))
 ;; Architectures that are able to build or cross-build Guix System images.
 ;; This does not mean that other architectures are not supported, only that
 ;; they are often not fast enough to support Guix System images building.
@@ -207,63 +284,51 @@ SYSTEM."
  (list hurd-barebones-qcow2-image
        pine64-barebones-raw-image))
 (define (hours hours)
  (* 3600 hours))
 (define* (image->job store image
                     #:key name system)
  "Return the job for IMAGE on SYSTEM.  If NAME is passed, use it as job name,
 otherwise use the IMAGE name."
  (let* ((image-name (or name
                         (symbol->string (image-name image))))
         (name (string-append image-name "." system))
         (drv (run-with-store store
                (mbegin %store-monad
                  (set-guile-for-build (default-guile))
                  (lower-object (system-image image))))))
    (parameterize ((%graft? #f))
      (derivation->job name drv))))
 (define (image-jobs store system)
  "Return a list of jobs that build images for SYSTEM."
  (define (->alist drv)
    `((derivation . ,(derivation-file-name drv))
      (log . ,(log-file store (derivation-file-name drv)))
      (outputs . ,(filter-map (lambda (res)
                                (match res
                                  ((name . path)
                                   `(,name . ,path))))
                              (derivation->output-paths drv)))
      (nix-name . ,(derivation-name drv))
      (system . ,(derivation-system drv))
      (description . "Stand-alone image of the GNU system")
      (long-description . "This is a demo stand-alone image of the GNU
 system.")
      (license . ,(license-name gpl3+))
      (max-silent-time . 600)
      (timeout . 3600)
      (home-page . ,%guix-home-page-url)
      (maintainers . ("bug-guix@gnu.org"))))
  (define (->job name drv)
    (let ((name (symbol-append name (string->symbol ".")
                               (string->symbol system))))
      `(,name . ,(lambda ()
                   (parameterize ((%graft? #f))
                     (->alist drv))))))
  (define (build-image image)
    (run-with-store store
      (mbegin %store-monad
        (set-guile-for-build (default-guile))
        (lower-object (system-image image)))))
  (define MiB
    (expt 2 20))
  (if (member system %guix-system-supported-systems)
-      `(,(->job 'usb-image
+      `(,(image->job store
-                (build-image
+                     (image
-                 (image
+                      (inherit efi-disk-image)
-                  (inherit efi-disk-image)
+                      (operating-system installation-os))
-                  (operating-system installation-os))))
+                     #:name "usb-image"
-        ,(->job 'iso9660-image
+                     #:system system)
-                (build-image
+        ,(image->job
-                 (image
+          store
-                  (inherit (image-with-label
+          (image
-                             iso9660-image
+           (inherit (image-with-label
-                             (string-append "GUIX_" system "_"
+                     iso9660-image
-                                            (if (> (string-length %guix-version) 7)
+                     (string-append "GUIX_" system "_"
-                                                (substring %guix-version 0 7)
+                                    (if (> (string-length %guix-version) 7)
-                                                %guix-version))))
+                                        (substring %guix-version 0 7)
-                  (operating-system installation-os))))
+                                        %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 (lambda (image)
+              (map (cut image->job store <>
-                     (->job (image-name image) (build-image image)))
+                        #:system system)
                   %guix-system-images)
              '()))
      '()))
@@ -311,39 +376,17 @@ system.")
 (define* (system-test-jobs store system
                           #:key source commit)
  "Return a list of jobs for the system tests."
  (define (test->thunk test)
    (lambda ()
      (define drv
        (run-with-store store
          (mbegin %store-monad
            (set-current-system system)
            (set-grafting #f)
            (set-guile-for-build (default-guile))
            (system-test-value test))))
      `((derivation . ,(derivation-file-name drv))
        (log . ,(log-file store (derivation-file-name drv)))
        (outputs . ,(filter-map (lambda (res)
                                  (match res
                                    ((name . path)
                                     `(,name . ,path))))
                                (derivation->output-paths drv)))
        (nix-name . ,(derivation-name drv))
        (system . ,(derivation-system drv))
        (description . ,(format #f "Guix '~a' system test"
                                (system-test-name test)))
        (long-description . ,(system-test-description test))
        (license . ,(license-name gpl3+))
        (max-silent-time . 600)
        (timeout . 3600)
        (home-page . ,%guix-home-page-url)
        (maintainers . ("bug-guix@gnu.org")))))
  (define (->job test)
-    (let ((name (string->symbol
+    (let ((name (string-append "test." (system-test-name test)
-                 (string-append "test." (system-test-name test)
+                               "." system))
-                                "." system))))
+          (drv (run-with-store store
-      (cons name (test->thunk test))))
+                 (mbegin %store-monad
                   (set-current-system system)
                   (set-grafting #f)
                   (set-guile-for-build (default-guile))
                   (system-test-value test)))))
      (derivation->job name drv)))
  (if (member system %guix-system-supported-systems)
      ;; Override the value of 'current-guix' used by system tests.  Using a
@@ -356,63 +399,45 @@ system.")
      '()))
 (define (tarball-jobs store system)
-  "Return Hydra jobs to build the self-contained Guix binary tarball."
+  "Return jobs to build the self-contained Guix binary tarball."
  (define (->alist drv)
    `((derivation . ,(derivation-file-name drv))
      (log . ,(log-file store (derivation-file-name drv)))
      (outputs . ,(filter-map (lambda (res)
                                (match res
                                  ((name . path)
                                   `(,name . ,path))))
                              (derivation->output-paths drv)))
      (nix-name . ,(derivation-name drv))
      (system . ,(derivation-system drv))
      (description . "Stand-alone binary Guix tarball")
      (long-description . "This is a tarball containing binaries of Guix and
 all its dependencies, and ready to be installed on \"foreign\" distributions.")
      (license . ,(license-name gpl3+))
      (home-page . ,%guix-home-page-url)
      (maintainers . ("bug-guix@gnu.org"))))
  (define (->job name drv)
-    (let ((name (symbol-append name (string->symbol ".")
+    (let ((name (string-append name "." system)))
-                               (string->symbol system))))
+      (parameterize ((%graft? #f))
-      `(,name . ,(lambda ()
+        (derivation->job name drv))))
                   (parameterize ((%graft? #f))
                     (->alist drv))))))
  ;; XXX: Add a job for the stable Guix?
-  (list (->job 'binary-tarball
+  (list
-               (run-with-store store
+   (->job "binary-tarball"
-                 (mbegin %store-monad
+          (run-with-store store
-                   (set-guile-for-build (default-guile))
+            (mbegin %store-monad
-                   (>>= (profile-derivation (packages->manifest (list guix)))
+              (set-guile-for-build (default-guile))
-                        (lambda (profile)
+              (>>= (profile-derivation (packages->manifest (list guix)))
-                          (self-contained-tarball "guix-binary" profile
+                   (lambda (profile)
-                                                  #:localstatedir? #t
+                     (self-contained-tarball "guix-binary" profile
-                                                  #:compressor
+                                             #:profile-name "current-guix"
-                                                  (lookup-compressor "xz")))))
+                                             #:localstatedir? #t
-                 #:system system))))
+                                             #:compressor
                                             (lookup-compressor "xz")))))
            #:system system))))
 (define job-name
  ;; Return the name of a package's job.
-  (compose string->symbol
+  package-name)
           (cut package-full-name <> "-")))
 (define package->job
  (let ((base-packages
         (delete-duplicates
          (append-map (match-lambda
-                       ((_ package _ ...)
+                        ((_ package _ ...)
-                        (match (package-transitive-inputs package)
+                         (match (package-transitive-inputs package)
-                          (((_ inputs _ ...) ...)
+                           (((_ inputs _ ...) ...)
-                           inputs))))
+                            inputs))))
                      (%final-inputs)))))
    (lambda (store package system)
      "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
 valid."
      (cond ((member package base-packages)
-             (package-job store (symbol-append 'base. (job-name package))
+             (package-job store (string-append "base." (job-name package))
                          package system))
            ((supported-package? package system)
             (let ((drv (package-derivation store package system
@@ -446,14 +471,15 @@ valid."
                          packages)))
                 #:select? (const #t)))           ;include hidden packages
-(define (arguments->manifests arguments)
+(define (arguments->manifests arguments channels)
  "Return the list of manifests extracted from ARGUMENTS."
-  (map (match-lambda
+  (map (lambda (manifest)
-         ((input-name . relative-path)
+         (any (lambda (checkout)
-          (let* ((checkout (assq-ref arguments (string->symbol input-name)))
+                (let ((path (in-vicinity checkout manifest)))
-                 (base (assq-ref checkout 'file-name)))
+                  (and (file-exists? path)
-            (in-vicinity base relative-path))))
+                       path)))
-       (assq-ref arguments 'manifests)))
+              (map channel-url channels)))
       arguments))
 (define (manifests->packages store manifests)
  "Return the list of packages found in MANIFESTS."
@@ -469,100 +495,123 @@ valid."
                             load-manifest)
                    manifests))))
-(define (find-current-checkout arguments)
+(define (arguments->systems arguments)
-  "Find the first checkout of ARGUMENTS that provided the current file.
+  "Return the systems list from ARGUMENTS."
-Return #f if no such checkout is found."
+  (match (assoc-ref arguments 'systems)
-  (let ((current-root
+    (#f              %cuirass-supported-systems)
-         (canonicalize-path
+    ((lst ...)       lst)
-          (string-append (dirname (current-filename)) "/.."))))
+    ((? string? str) (call-with-input-string str read))))
    (find (lambda (argument)
            (and=> (assq-ref argument 'file-name)
                   (lambda (name)
                     (string=? name current-root)))) arguments)))
 ;;;
-;;; Hydra entry point.
+;;; Cuirass entry point.
 ;;;
-(define (hydra-jobs store arguments)
+(define (cuirass-jobs store arguments)
-  "Return Hydra jobs."
+  "Register Cuirass jobs."
  (define subset
-    (match (assoc-ref arguments 'subset)
+    (assoc-ref arguments 'subset))
      ("core" 'core)                              ; only build core packages
      ("hello" 'hello)                            ; only build hello
      (((? string?) (? string?) ...) 'list)       ; only build selected list of packages
      ("manifests" 'manifests)                    ; only build packages in the list of manifests
      (_ 'all)))                                  ; build everything
  (define systems
-    (match (assoc-ref arguments 'systems)
+    (arguments->systems arguments))
      (#f              %hydra-supported-systems)
      ((lst ...)       lst)
      ((? string? str) (call-with-input-string str read))))
-  (define checkout
+  (define channels
-    (or (find-current-checkout arguments)
+    (let ((channels (assq-ref arguments 'channels)))
-        (assq-ref arguments 'superior-guix-checkout)))
+      (map sexp->channel channels)))
  (define guix
    (find guix-channel? channels))
  (define commit
-    (assq-ref checkout 'revision))
+    (channel-commit guix))
  (define source
-    (assq-ref checkout 'file-name))
+    (channel-url guix))
  ;; Turn off grafts.  Grafting is meant to happen on the user's machines.
  (parameterize ((%graft? #f))
    ;; Return one job for each package, except bootstrap packages.
-    (append-map (lambda (system)
+    (append-map
-                  (format (current-error-port)
+     (lambda (system)
-                          "evaluating for '~a' (heap size: ~a MiB)...~%"
+       (format (current-error-port)
-                          system
+               "evaluating for '~a' (heap size: ~a MiB)...~%"
-                          (round
+               system
-                           (/ (assoc-ref (gc-stats) 'heap-size)
+               (round
-                              (expt 2. 20))))
+                (/ (assoc-ref (gc-stats) 'heap-size)
-                  (invalidate-derivation-caches!)
+                   (expt 2. 20))))
-                  (case subset
+       (invalidate-derivation-caches!)
-                    ((all)
+       (match subset
-                     ;; Build everything, including replacements.
+         ('all
-                     (let ((all (all-packages))
+          ;; Build everything, including replacements.
-                           (job (lambda (package)
+          (let ((all (all-packages))
-                                  (package->job store package
+                (job (lambda (package)
-                                                system))))
+                       (package->job store package system))))
-                       (append (filter-map job all)
+            (append
-                               (image-jobs store system)
+             (filter-map job all)
-                               (system-test-jobs store system
+             (cross-jobs store system))))
-                                                 #:source source
+         ('core
-                                                 #:commit commit)
+          ;; Build core packages only.
-                               (tarball-jobs store system)
+          (append
-                               (cross-jobs store system))))
+           (map (lambda (package)
-                    ((core)
+                  (package-job store (job-name package)
-                     ;; Build core packages only.
+                               package system))
-                     (append (map (lambda (package)
+                %core-packages)
-                                    (package-job store (job-name package)
+           (cross-jobs store system)))
-                                                 package system))
+         ('guix
-                                  %core-packages)
+          ;; Build Guix modules only.
-                             (cross-jobs store system)))
+          (guix-jobs store systems
-                    ((hello)
+                     #:source source
-                     ;; Build hello package only.
+                     #:commit commit))
-                     (let ((hello (specification->package "hello")))
+         ('hello
-                       (list (package-job store (job-name hello) hello system))))
+          ;; Build hello package only.
-                    ((list)
+          (let ((hello (specification->package "hello")))
-                     ;; Build selected list of packages only.
+            (list (package-job store (job-name hello)
-                     (let* ((names (assoc-ref arguments 'subset))
+                               hello system))))
-                            (packages (map specification->package names)))
+         ('images
-                       (map (lambda (package)
+          ;; Build Guix System images only.
-                              (package-job store (job-name package)
+          (image-jobs store system))
-                                           package system))
+         ('system-tests
-                            packages)))
+          ;; Build Guix System tests only.
-                    ((manifests)
+          (system-test-jobs store system
-                     ;; Build packages in the list of manifests.
+                            #:source source
-                     (let* ((manifests (arguments->manifests arguments))
+                            #:commit commit))
-                            (packages (manifests->packages store manifests)))
+         ('tarball
-                       (map (lambda (package)
+          ;; Build Guix tarball only.
-                              (package-job store (job-name package)
+          (tarball-jobs store system))
-                                           package system))
+         (('custom . modules)
-                            packages)))
+          ;; Build custom modules jobs only.
-                    (else
+          (append-map
-                     (error "unknown subset" subset))))
+           (lambda (module)
-                systems)))
+             (let ((proc (module-ref
                          (resolve-interface module)
                          'cuirass-jobs)))
               (proc store arguments)))
           modules))
         (('channels . channels)
          ;; Build only the packages from CHANNELS.
          (let ((all (all-packages)))
            (filter-map
             (lambda (package)
               (any (lambda (channel)
                      (and (member (channel-name channel) channels)
                           (package->job store package system)))
                    (package-channels package)))
             all)))
         (('packages . rest)
          ;; Build selected list of packages only.
          (let ((packages (map specification->package rest)))
            (map (lambda (package)
                   (package-job store (job-name package)
                                package system))
                 packages)))
         (('manifests . rest)
          ;; Build packages in the list of manifests.
          (let* ((manifests (arguments->manifests rest channels))
                 (packages (manifests->packages store manifests)))
            (map (lambda (package)
                   (package-job store (job-name package)
                                package system))
                 packages)))
         (else
          (error "unknown subset" subset))))
     systems)))
@@ -41,7 +41,7 @@ msgstr ""
 "Project-Id-Version: guix-manual 1.2.0-pre3\n"
 "Report-Msgid-Bugs-To: bug-guix@gnu.org\n"
 "POT-Creation-Date: 2020-11-05 17:27+0100\n"
-"PO-Revision-Date: 2020-11-20 14:37+0100\n"
+"PO-Revision-Date: 2020-11-24 17:52+0100\n"
 "Last-Translator: Julien Lepiller <julien@lepiller.eu>\n"
 "Language-Team: French <traduc@traduc.org>\n"
 "Language: fr\n"
@@ -15988,7 +15988,7 @@ msgstr "{Procédure Scheme} copy-recursively @var{source} @var{destination} @"
 #: doc/guix.texi:8277
 msgid "[#:log (current-output-port)] [#:follow-symlinks? #f] [#:keep-mtime? #f] Copy @var{source} directory to @var{destination}.  Follow symlinks if @var{follow-symlinks?} is true; otherwise, just preserve them.  When @var{keep-mtime?} is true, keep the modification time of the files in @var{source} on those of @var{destination}.  Write verbose output to the @var{log} port."
 msgstr ""
-"[#:log (current-output-port)] [#:follow-symlinks ? #f] [#:keep-mtime ? #f] \n"
+"[#:log (current-output-port)] [#:follow-symlinks? #f] [#:keep-mtime? #f] \n"
 "Copie le répertoire @var{source} dans @var{destination}.  Suivez les liens symboliques si @var{follow-symlinks?} est vrai ; sinon, conservez-les.  Lorsque @var{keep-mtime?} est vrai, conservez les heures de modification des fichiers dans @var{source} sur celles de @var{destination}.  Écrivez une sortie verbeuse sur le port @var{log}."
 #. type: deffn
@@ -16091,7 +16091,7 @@ msgstr "{Procédure Scheme} find-files @var{dir} [@var{pred}] @"
 #: doc/guix.texi:8336
 msgid "[#:stat lstat] [#:directories? #f] [#:fail-on-error? #f] Return the lexicographically sorted list of files under @var{dir} for which @var{pred} returns true.  @var{pred} is passed two arguments: the absolute file name, and its stat buffer; the default predicate always returns true.  @var{pred} can also be a regular expression, in which case it is equivalent to @code{(file-name-predicate @var{pred})}.  @var{stat} is used to obtain file information; using @code{lstat} means that symlinks are not followed.  If @var{directories?} is true, then directories will also be included.  If @var{fail-on-error?} is true, raise an exception upon error."
 msgstr ""
-"[#:stat lstat] [#:directories ? #f] [#:fail-on-error ? #f] \n"
+"[#:stat lstat] [#:directories? #f] [#:fail-on-error? #f] \n"
 "Renvoie la liste des fichiers triés lexicographiquement sous @var{dir} pour lesquels @var{pred} renvoie « vrai ».  Deux arguments sont passés à @var{pred} : le nom absolu du fichier et son tampon stat ; le prédicat par défaut renvoie toujours « vrai ».  @var{pred} peut également être une expression régulière, auquel cas elle est équivalente à @code{(file-name-predicate @var{pred})}.  @var{stat} est utilisé pour obtenir des informations sur les fichiers ; l'utilisation de @code{lstat} signifie que les liens symboliques ne sont pas suivis.  Si @var{directories?} est vrai, alors les répertoires seront également inclus.  Si @var{fail-on-error?} est vrai, il lance une exception en cas d'erreur."
 #. type: Plain text
Author	SHA1	Message	Date
Mathieu Othacehe	8d84a9ee71	ci: Add missing include. * gnu/ci.scm: Add missing include.	2021-06-14 10:13:40 +02:00
Mathieu Othacehe	c13ad2b889	ci: Backport package-channels procedure. * gnu/ci.scm (package-channels): New procedure.	2021-06-14 10:08:49 +02:00
Mathieu Othacehe	7546a1d3c0	ci: Backport sexp->channel procedure. * gnu/ci.scm (sexp->channel): New procedure.	2021-06-14 09:09:25 +02:00
Mathieu Othacehe	1b0bfb5df1	ci: Update to the last version. * gnu/ci.scm: Update to the master version.	2021-06-14 09:03:26 +02:00
Maxim Cournoyer	8603bcd582	doc: Remove the guile-lib/htmlprag-fixed package. This hotfix package is no longer necessary as the ability to parameterize the way htmlprag tokenizes HTML was added in guile-lib 0.2.7. * doc/build.scm (guile-lib/htmlprag-fixed): Remove variable. (html-manual-identifier-index): Replace guile-lib/htmlprag-fixed by guile-lib, and make set the %strict-tokenizer? parameter to #t. (syntax-highlighted-html): Likewise.	2021-04-02 11:09:06 +02:00
Holger Peters	f350df405f	doc: Fix incorrect GUIX_PROFILE value for 'guix pull'. * doc/guix.texi (Getting Started): Fix invalid GUIX_PROFILE value. Signed-off-by: Ludovic Courtès <ludo@gnu.org>	2020-12-07 15:08:51 +01:00
Ludovic Courtès	91bcb1d043	nls: Update 'fr' translation of the manual.	2020-12-03 16:39:12 +01:00