Commit | Line | Data |
---|---|---|
11a54b3d | 1 | ;;; GNU Guix --- Functional package management for GNU |
530e31b8 | 2 | ;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> |
11a54b3d LC |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | ;;; | |
20 | ;;; This file defines a continuous integration job to build the same modular | |
21 | ;;; Guix as 'guix pull', which is defined in (guix self). | |
22 | ;;; | |
23 | ||
11a54b3d LC |
24 | (use-modules (guix store) |
25 | (guix config) | |
26 | (guix utils) | |
11a54b3d LC |
27 | ((guix packages) #:select (%hydra-supported-systems)) |
28 | (guix derivations) | |
29 | (guix monads) | |
11a54b3d LC |
30 | ((guix licenses) #:prefix license:) |
31 | (srfi srfi-1) | |
11a54b3d LC |
32 | (ice-9 match)) |
33 | ||
34 | ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output | |
35 | ;; port to the bit bucket, let us write to the error port instead. | |
530e31b8 | 36 | (setvbuf (current-error-port) 'line) |
11a54b3d LC |
37 | (set-current-output-port (current-error-port)) |
38 | ||
39 | (define* (build-job store source version system) | |
40 | "Return a Hydra job a list building the modular Guix derivation from SOURCE | |
41 | for SYSTEM. Use VERSION as the version identifier." | |
42 | (lambda () | |
9fe95946 LC |
43 | (define build |
44 | (primitive-load (string-append source "/build-aux/build-self.scm"))) | |
45 | ||
11a54b3d | 46 | `((derivation . ,(derivation-file-name |
9fe95946 | 47 | (run-with-store store |
16c28bec | 48 | (build source #:version version #:system system |
e740e8b2 | 49 | #:pull-version 1 |
16c28bec | 50 | #:guile-version "2.2")))) ;the latest 2.2.x |
11a54b3d LC |
51 | (description . "Modular Guix") |
52 | (long-description | |
53 | . "This is the modular Guix package as produced by 'guix pull'.") | |
54 | (license . ,license:gpl3+) | |
55 | (home-page . ,%guix-home-page-url) | |
56 | (maintainers . (,%guix-bug-report-address))))) | |
57 | ||
58 | (define (hydra-jobs store arguments) | |
59 | "Return Hydra jobs." | |
60 | (define systems | |
98cda1b9 LC |
61 | (match (assoc-ref arguments 'systems) |
62 | (#f %hydra-supported-systems) | |
63 | ((lst ...) lst) | |
64 | ((? string? str) (call-with-input-string str read)))) | |
11a54b3d LC |
65 | |
66 | (define guix-checkout | |
351f384e LC |
67 | (or (assq-ref arguments 'guix) ;Hydra on hydra |
68 | (assq-ref arguments 'guix-modular))) ;Cuirass on berlin | |
11a54b3d LC |
69 | |
70 | (define version | |
71 | (or (assq-ref guix-checkout 'revision) | |
72 | "0.unknown")) | |
73 | ||
74 | (let ((file (assq-ref guix-checkout 'file-name))) | |
351f384e LC |
75 | (format (current-error-port) "using checkout ~s (~s; arguments: ~s)~%" |
76 | guix-checkout file arguments) | |
11a54b3d LC |
77 | |
78 | (map (lambda (system) | |
79 | (let ((name (string->symbol | |
80 | (string-append "guix." system)))) | |
81 | `(,name | |
82 | . ,(build-job store file version system)))) | |
98cda1b9 | 83 | systems))) |