1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Mathieu Othacehe <othacehe@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 program replicates the behavior of Hydra's 'hydra-eval-guile-job'.
;;; It evaluates the Hydra job defined by the program passed as its first
;;; arguments and outputs an sexp of the jobs on standard output.
(use-modules (guix store)
(guix git-download)
((guix build utils) #:select (with-directory-excursion))
((guix ui) #:select (build-notifier))
(srfi srfi-19)
(ice-9 match)
(ice-9 pretty-print)
(ice-9 format))
(define %top-srcdir
(and=> (assq-ref (current-source-location) 'filename)
(lambda (file)
(canonicalize-path
(string-append (dirname file) "/../..")))))
(define %user-module
;; Hydra user module.
(let ((m (make-module)))
(beautify-user-module! m)
m))
(define (call-with-time thunk kont)
"Call THUNK and pass KONT the elapsed time followed by THUNK's return
values."
(let* ((start (current-time time-monotonic))
(result (call-with-values thunk list))
(end (current-time time-monotonic)))
(apply kont (time-difference end start) result)))
(define (call-with-time-display thunk)
"Call THUNK and write to the current output port its duration."
(call-with-time thunk
(lambda (time . results)
(format #t "~,3f seconds~%"
(+ (time-second time)
(/ (time-nanosecond time) 1e9)))
(apply values results))))
(define (assert-valid-job job thing)
"Raise an error if THING is not an alist with a valid 'derivation' entry.
Otherwise return THING."
(unless (and (list? thing)
(and=> (assoc-ref thing 'derivation)
(lambda (value)
(and (string? value)
(string-suffix? ".drv" value)))))
(error "job did not produce a valid alist" job thing))
thing)
\f
;; Without further ado...
(match (command-line)
((command file output)
;; Load FILE, a Scheme file that defines Hydra jobs.
(let ((port (current-output-port))
(real-build-things build-things))
(with-store store
;; Make sure we don't resort to substitutes.
(set-build-options store
#:use-substitutes? #f
#:substitute-urls '())
;; The evaluation of Guix itself requires building a "trampoline"
;; program, and possibly everything it depends on. Thus, allow builds
;; but print a notification.
(with-build-handler (build-notifier #:use-substitutes? #f)
;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
;; from a clean checkout
(let ((source (add-to-store store "guix-source" #t
"sha256" %top-srcdir
#:select? (git-predicate %top-srcdir))))
(with-directory-excursion source
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(format (current-error-port)
"loading '~a' relative to '~a'...~%"
file source)
(primitive-load file))))
(call-with-output-file output
(lambda (port)
((module-ref %user-module 'cuirass-jobs)
store
`((guix-modular . ((file-name . ,source))))
(lambda args
(write args port))))))))))
((command _ ...)
(format (current-error-port) "Usage: ~a FILE [cuirass]
Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
command)
(exit 1)))
;;; Local Variables:
;;; eval: (put 'call-with-time 'scheme-indent-function 1)
;;; End:
|