From bb82d85df2380cd0c25de0f659a7010f2d88ee4f Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 16 Sep 2017 12:57:37 +0200
Subject: [PATCH] cuirass: Add gnu-system build spec.

* build-aux/hydra/gnu-system.scm (hydra-jobs): Add subsets "hello"
and list of packages: ("name[@version" ...).
* guix/licenses.scm: Export <license>.
* build-aux/cuirass/gnu-system.scm: New file.
* doc/guix.texi (Continuous Integration): Update example spec.
---
 build-aux/cuirass/gnu-system.scm | 45 ++++++++++++++++++++++++++++++++++++++++
 build-aux/hydra/gnu-system.scm   | 19 +++++++++++++++++
 doc/guix.texi                    |  4 ++--
 guix/licenses.scm                |  3 ++-
 4 files changed, 68 insertions(+), 3 deletions(-)
 create mode 100644 build-aux/cuirass/gnu-system.scm

diff --git a/build-aux/cuirass/gnu-system.scm b/build-aux/cuirass/gnu-system.scm
new file mode 100644
index 000000000..0028d9d8e
--- /dev/null
+++ b/build-aux/cuirass/gnu-system.scm
@@ -0,0 +1,45 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;;;
+;;; This file defines build jobs for the Cuirass continuation integration
+;;; tool.
+;;;
+
+(include-from-path "build-aux/hydra/gnu-system.scm")
+
+(use-modules ((guix licenses) #:select (<license>)))
+
+(define (cuirass-jobs store arguments)
+  "Return Cuirass jobs."
+  (map hydra-job->cuirass-job (hydra-jobs store arguments)))
+
+(define (hydra-job->cuirass-job hydra-job)
+  (let ((name (car hydra-job))
+        (job ((cdr hydra-job))))
+    (lambda _ (acons #:job-name (symbol->string name)
+                     (map symbol-alist-entry->keyword-alist-entry job)))))
+
+(define (symbol-alist-entry->keyword-alist-entry entry)
+  (cons (symbol->keyword (car entry)) (entry->sexp-entry (cdr entry))))
+
+(define (entry->sexp-entry o)
+  (match o
+    (($ <license> name uri comment)
+     `((name . ,name) (uri . ,uri) (comment . ,comment)))
+    (_ o)))
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index 73bd566f7..146d929f9 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -270,6 +271,8 @@ valid."
   (define subset
     (match (assoc-ref arguments 'subset)
       ("core" 'core)                              ; only build core packages
+      ("hello" 'hello)                            ; only build hello
+      (((? string?) (? string?) ...) 'list)       ; only build selected list of packages
       (_ 'all)))                                  ; build everything
 
   (define (cross-jobs system)
@@ -340,6 +343,22 @@ valid."
                                                  package system))
                                   %core-packages)
                              (cross-jobs system)))
+                    ((hello)
+                     ;; Build hello package only.
+                     (if (string=? system (%current-system))
+                         (let ((hello (specification->package "hello")))
+                           (list (package-job store (job-name hello) hello system)))
+                         '()))
+                    ((list)
+                     ;; Build selected list of packages only.
+                     (if (string=? system (%current-system))
+                         (let* ((names (assoc-ref arguments 'subset))
+                                (packages (map specification->package names)))
+                           (map (lambda (package)
+                                    (package-job store (job-name package)
+                                                 package system))
+                                  packages))
+                         '()))
                     (else
                      (error "unknown subset" subset))))
                 %hydra-supported-systems)))
diff --git a/doc/guix.texi b/doc/guix.texi
index fff3fbd5f..c1391ee4b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -15375,8 +15375,8 @@ packages, as prescribed in the @file{gnu-system.scm} example spec:
                             cuirass
                             "/tests/gnu-system.scm"))
 
-               (#:proc . hydra-jobs)
-               (#:arguments (subset . "hello"))
+               (#:proc . cuirass-jobs)
+               (#:arguments (subset . ("hello" "grep")))
                (#:branch . "master"))))
   (service cuirass-service-type
            (cuirass-configuration
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 6de611da2..144dd06f0 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -31,7 +31,8 @@
 
 (define-module (guix licenses)
   #:use-module (srfi srfi-9)
-  #:export (license? license-name license-uri license-comment
+  #:export (<license>
+            license? license-name license-uri license-comment
             agpl1 agpl3 agpl3+
             asl1.1 asl2.0
             boost1.0
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com