Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
530e31b8 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> |
516b5382 | 3 | ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org> |
f71b0a00 | 4 | ;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org> |
8c0e5b1e | 5 | ;;; |
233e7676 | 6 | ;;; This file is part of GNU Guix. |
8c0e5b1e | 7 | ;;; |
233e7676 | 8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
8c0e5b1e LC |
9 | ;;; under the terms of the GNU General Public License as published by |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
233e7676 | 13 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
8c0e5b1e LC |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
233e7676 | 19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
8c0e5b1e LC |
20 | |
21 | ;;; | |
22 | ;;; This file defines build jobs for the Hydra continuation integration | |
23 | ;;; tool. | |
24 | ;;; | |
25 | ||
b5f8c2c8 LC |
26 | (use-modules (guix inferior) (guix channels) |
27 | (guix) | |
28 | (guix ui) | |
29 | (srfi srfi-1) | |
30 | (ice-9 match)) | |
e2e6e9eb | 31 | |
b5f8c2c8 LC |
32 | ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output |
33 | ;; port to the bit bucket, let us write to the error port instead. | |
530e31b8 | 34 | (setvbuf (current-error-port) 'line) |
b5f8c2c8 | 35 | (set-current-output-port (current-error-port)) |
bb90ad83 | 36 | |
f71b0a00 CL |
37 | (define (find-current-checkout arguments) |
38 | "Find the first checkout of ARGUMENTS that provided the current file. | |
39 | Return #f if no such checkout is found." | |
40 | (let ((current-root | |
41 | (canonicalize-path | |
42 | (string-append (dirname (current-filename)) "/../..")))) | |
43 | (find (lambda (argument) | |
44 | (and=> (assq-ref argument 'file-name) | |
45 | (lambda (name) | |
46 | (string=? name current-root)))) arguments))) | |
47 | ||
b5f8c2c8 LC |
48 | (define (hydra-jobs store arguments) |
49 | "Return a list of jobs where each job is a NAME/THUNK pair." | |
f71b0a00 | 50 | |
b5f8c2c8 | 51 | (define checkout |
f71b0a00 | 52 | (find-current-checkout arguments)) |
e2e6e9eb | 53 | |
b5f8c2c8 LC |
54 | (define commit |
55 | (assq-ref checkout 'revision)) | |
bb90ad83 | 56 | |
b5f8c2c8 LC |
57 | (define source |
58 | (assq-ref checkout 'file-name)) | |
f6dfb8bb | 59 | |
b5f8c2c8 LC |
60 | (define instance |
61 | (checkout->channel-instance source #:commit commit)) | |
0b5aa854 | 62 | |
b5f8c2c8 LC |
63 | (define derivation |
64 | ;; Compute the derivation of Guix for COMMIT. | |
65 | (run-with-store store | |
66 | (channel-instances->derivation (list instance)))) | |
8c0e5b1e | 67 | |
66a198c8 LC |
68 | ;; TODO: Remove 'show-what-to-build' call when Cuirass' 'evaluate' scripts |
69 | ;; uses 'with-build-handler'. | |
b5f8c2c8 LC |
70 | (show-what-to-build store (list derivation)) |
71 | (build-derivations store (list derivation)) | |
72 | ||
73 | ;; Open an inferior for the just-built Guix. | |
74 | (let ((inferior (open-inferior (derivation->output-path derivation)))) | |
75 | (inferior-eval '(use-modules (gnu ci) (ice-9 match)) inferior) | |
dce3a40b | 76 | |
b5f8c2c8 LC |
77 | (map (match-lambda |
78 | ((name . fields) | |
79 | ;; Hydra expects a thunk, so here it is. | |
80 | (cons name (lambda () fields)))) | |
f71b0a00 CL |
81 | (inferior-eval-with-store |
82 | inferior store | |
83 | `(lambda (store) | |
84 | (map (match-lambda | |
85 | ((name . thunk) | |
86 | (cons name (thunk)))) | |
87 | (hydra-jobs store '((superior-guix-checkout . ,checkout) | |
88 | ,@arguments)))))))) |