Commit | Line | Data |
---|---|---|
89cbec89 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> | |
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 | ;;; This program replicates the behavior of Hydra's 'hydra-eval-guile-job'. | |
20 | ;;; It evaluates the Hydra job defined by the program passed as its first | |
21 | ;;; arguments and outputs an sexp of the jobs on standard output. | |
22 | ||
23 | (use-modules (guix store) | |
24 | (srfi srfi-19) | |
25 | (ice-9 match) | |
26 | (ice-9 pretty-print) | |
27 | (ice-9 format)) | |
28 | ||
29 | (define %user-module | |
30 | ;; Hydra user module. | |
31 | (let ((m (make-module))) | |
32 | (beautify-user-module! m) | |
33 | m)) | |
34 | ||
35 | (define (call-with-time thunk kont) | |
36 | "Call THUNK and pass KONT the elapsed time followed by THUNK's return | |
37 | values." | |
38 | (let* ((start (current-time time-monotonic)) | |
39 | (result (call-with-values thunk list)) | |
40 | (end (current-time time-monotonic))) | |
41 | (apply kont (time-difference end start) result))) | |
42 | ||
43 | (define (call-with-time-display thunk) | |
44 | "Call THUNK and write to the current output port its duration." | |
45 | (call-with-time thunk | |
46 | (lambda (time . results) | |
47 | (format #t "~,3f seconds~%" | |
48 | (+ (time-second time) | |
49 | (/ (time-nanosecond time) 1e9))) | |
50 | (apply values results)))) | |
51 | ||
4c9243b6 LC |
52 | (define (assert-valid-job job thing) |
53 | "Raise an error if THING is not an alist with a valid 'derivation' entry. | |
54 | Otherwise return THING." | |
55 | (unless (and (list? thing) | |
56 | (and=> (assoc-ref thing 'derivation) | |
57 | (lambda (value) | |
58 | (and (string? value) | |
59 | (string-suffix? ".drv" value))))) | |
60 | (error "job did not produce a valid alist" job thing)) | |
61 | thing) | |
62 | ||
89cbec89 LC |
63 | \f |
64 | ;; Without further ado... | |
65 | (match (command-line) | |
66 | ((command file) | |
67 | ;; Load FILE, a Scheme file that defines Hydra jobs. | |
68 | (let ((port (current-output-port))) | |
69 | (save-module-excursion | |
70 | (lambda () | |
71 | (set-current-module %user-module) | |
72 | (primitive-load file))) | |
73 | ||
74 | (with-store store | |
75 | ;; Make sure we don't resort to substitutes. | |
76 | (set-build-options store | |
77 | #:use-substitutes? #f | |
78 | #:substitute-urls '()) | |
79 | ||
80 | ;; Grafts can trigger early builds. We do not want that to happen | |
81 | ;; during evaluation, so use a sledgehammer to catch such problems. | |
82 | (set! build-things | |
83 | (lambda (store . args) | |
84 | (format (current-error-port) | |
85 | "error: trying to build things during evaluation!~%") | |
86 | (format (current-error-port) | |
87 | "'build-things' arguments: ~s~%" args) | |
88 | (exit 1))) | |
89 | ||
90 | ;; Call the entry point of FILE and print the resulting job sexp. | |
91 | (pretty-print | |
92 | (match ((module-ref %user-module 'hydra-jobs) store '()) | |
93 | (((names . thunks) ...) | |
94 | (map (lambda (job thunk) | |
95 | (format (current-error-port) "evaluating '~a'... " job) | |
96 | (force-output (current-error-port)) | |
4c9243b6 LC |
97 | (cons job |
98 | (assert-valid-job job | |
99 | (call-with-time-display thunk)))) | |
89cbec89 LC |
100 | names thunks))) |
101 | port)))) | |
102 | ((command _ ...) | |
103 | (format (current-error-port) "Usage: ~a FILE | |
104 | Evaluate the Hydra jobs defined in FILE.~%" | |
105 | command) | |
106 | (exit 1))) | |
107 | ||
108 | ;;; Local Variables: | |
109 | ;;; eval: (put 'call-with-time 'scheme-indent-function 1) | |
110 | ;;; End: | |
111 |