job: Add <job-spec> record type.

* src/cuirass/job.scm <job-spec>: New record type.
(%make-job-spec, make-job-spec, job-spec-name, job-spec-proc)
(job-spec-metadata): New procedures.
* tests/gnu-system.scm (package-job): Rename to ...
(package-job-spec): ... this.  Use 'make-job-spec'.
(package-cross-job): Rename to ...
(package-cross-job-spec): ... this.  Use 'make-job-spec'.
(tarball-jobs): Rename to ...
(tarball-job-specs): ... this.  Use 'make-job-spec'.
(package->alist): Rename to ...
(package-metadata): ... this.  Adapt.
(package->job): Rename to ...
(package->jobspec): ... this.  Adapt.
(hydra-jobs): Adapt.

1 files changed, 66 insertions, 62 deletions

diff --git a/tests/gnu-system.scm b/tests/gnu-system.scm
index 13f4898..943ae26 100644
--- a/tests/gnu-system.scm
+++ b/tests/gnu-system.scm
@@ -25,7 +25,8 @@
   ;; newer, even though they may not correspond.
   (set! %fresh-auto-compile #t))
 
-(use-modules (guix config)
+(use-modules (cuirass job)
+             (guix config)
              (guix store)
              (guix grafts)
              (guix packages)
@@ -52,39 +53,46 @@
              (srfi srfi-26)
              (ice-9 match))
 
-(define* (package->alist store package system
-                         #:optional (package-derivation package-derivation))
+(define (package-metadata package)
   "Convert PACKAGE to an alist suitable for Hydra."
-  (parameterize ((%graft? #f))
-    `((derivation . ,(derivation-file-name
-                      (package-derivation store package system
-                                          #:graft? #f)))
-      (description . ,(package-synopsis package))
-      (long-description . ,(package-description package))
-      (license . ,(package-license package))
-      (home-page . ,(package-home-page package))
-      (maintainers . ("bug-guix@gnu.org"))
-      (max-silent-time . ,(or (assoc-ref (package-properties package)
-                                         'max-silent-time)
-                              3600))              ;1 hour by default
-      (timeout . ,(or (assoc-ref (package-properties package) 'timeout)
-                      72000)))))                  ;20 hours by default
-
-(define (package-job store job-name package system)
-  "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
-  (let ((job-name (symbol-append job-name (string->symbol ".")
-                                 (string->symbol system))))
-    `(,job-name . ,(cut package->alist store package system))))
-
-(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
-                    (string->symbol ".") (string->symbol system)) .
-    ,(cute package->alist store package system
-           (lambda* (store package system #:key graft?)
-             (package-cross-derivation store package target system
-                                       #:graft? graft?)))))
+  `((description . ,(package-synopsis package))
+    (long-description . ,(package-description package))
+    (license . ,(package-license package))
+    (home-page . ,(package-home-page package))
+    (maintainers . ("bug-guix@gnu.org"))
+    (max-silent-time . ,(or (assoc-ref (package-properties package)
+                                       'max-silent-time)
+                            3600))      ;1 hour by default
+    (timeout . ,(or (assoc-ref (package-properties package) 'timeout)
+                    72000))))           ;20 hours by default
+
+(define (package-job-spec store job-name package system)
+  "Return a non evaluated job called JOB-NAME that builds PACKAGE on SYSTEM."
+  (make-job-spec
+   #:name
+   (string-append (symbol->string job-name) "." system)
+   #:procedure
+   (λ ()
+     (derivation-file-name
+      (parameterize ((%graft? #f))
+        (package-derivation store package system #:graft? #f))))
+   #:metadata
+   (package-metadata package)))
+
+(define (package-cross-job-spec store job-name package target system)
+  "Return a non evaluated job called TARGET.JOB-NAME that cross-builds PACKAGE
+for TARGET on SYSTEM."
+  (make-job-spec
+   #:name
+   (string-append target "." (symbol->string job-name) "." system)
+   #:procedure
+   (λ ()
+     (derivation-file-name
+      (parameterize ((%graft? #f))
+        (package-cross-derivation store package target system
+                                  #:graft? #f))))
+   #:metadata
+   (package-metadata package)))
 
 (define %core-packages
   ;; Note: Don't put the '-final' package variants because (1) that's
@@ -107,37 +115,34 @@ SYSTEM."
   '("mips64el-linux-gnu"
     "mips64el-linux-gnuabi64"))
 
-(define (tarball-jobs store system)
+(define (tarball-job-specs store system)
   "Return Hydra jobs to build the self-contained Guix binary tarball."
-  (define (->alist drv)
-    `((derivation . ,(derivation-file-name drv))
-      (description . "Stand-alone binary Guix tarball")
+  (list
+   (make-job-spec
+    #:name
+    (string-append "binary-tarball." system)
+    #:procedure
+    (λ ()
+      (derivation-file-name
+       (parameterize ((%graft? #f))
+         (run-with-store store
+           (mbegin %store-monad
+             (set-guile-for-build (default-guile))
+             (self-contained-tarball))
+           #:system system))))
+    #:metadata
+    `((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 non-GuixSD distributions.")
       (license . ,gpl3+)
       (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))))))
-
-  ;; XXX: Add a job for the stable Guix?
-  (list (->job 'binary-tarball
-               (run-with-store store
-                 (mbegin %store-monad
-                   (set-guile-for-build (default-guile))
-                   (self-contained-tarball))
-                 #:system system))))
+      (maintainers . ("bug-guix@gnu.org"))))))
 
 (define job-name
   ;; Return the name of a package's job.
   (compose string->symbol package-full-name))
 
-(define package->job
+(define package->job-spec
   (let ((base-packages
          (delete-duplicates
           (append-map (match-lambda
@@ -152,7 +157,7 @@ valid."
       (cond ((member package base-packages)
              #f)
             ((supported-package? package system)
-             (package-job store (job-name package) package system))
+             (package-job-spec store (job-name package) package system))
             (else
              #f)))))
 
@@ -189,8 +194,8 @@ valid."
 
     (append-map (lambda (target)
                   (map (lambda (package)
-                         (package-cross-job store (job-name package)
-                                            package target system))
+                         (package-cross-job-spec store (job-name package)
+                                                 package target system))
                        %packages-to-cross-build))
                 (remove (either from-32-to-64? same?) %cross-targets)))
 
@@ -210,16 +215,15 @@ valid."
                                        (cons package result)))
                                  '()))
                            (job (lambda (package)
-                                  (package->job store package
-                                                system))))
+                                  (package->job-spec store package system))))
                        (append (filter-map job all)
-                               (tarball-jobs store system)
+                               (tarball-job-specs store system)
                                (cross-jobs system))))
                     ((core)
                      ;; Build core packages only.
                      (append (map (lambda (package)
-                                    (package-job store (job-name package)
-                                                 package system))
+                                    (package-job-spec store (job-name package)
+                                                      package system))
                                   %core-packages)
                              (cross-jobs system)))
                     (else