gnu: kdenlive: Add missing dependencies.

[jackhill/guix/guix.git] / build-aux / hydra / evaluate.scm

diff --git a/build-aux/hydra/evaluate.scm b/build-aux/hydra/evaluate.scm
index cc6a4b9..c74fcdb 100644 (file)
--- a/build-aux/hydra/evaluate.scm
+++ b/build-aux/hydra/evaluate.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,24 +22,26 @@
 ;;; 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))
 
-(cond-expand
-  (guile-2.2
-   ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
-   ;; nanoseconds swapped (fixed in Guile commit 886ac3e).  Work around it.
-   (define time-monotonic time-tai))
-  (else #t))
-
 (define (call-with-time thunk kont)
   "Call THUNK and pass KONT the elapsed time followed by THUNK's return
 values."
@@ -70,45 +73,55 @@ Otherwise return THING."
 \f
 ;; Without further ado...
 (match (command-line)
-  ((command file)
+  ((command file cuirass? ...)
    ;; Load FILE, a Scheme file that defines Hydra jobs.
-   (let ((port (current-output-port)))
-     (save-module-excursion
-      (lambda ()
-        (set-current-module %user-module)
-        (primitive-load file)))
-
+   (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 '())
 
-       ;; Grafts can trigger early builds.  We do not want that to happen
-       ;; during evaluation, so use a sledgehammer to catch such problems.
-       (set! build-things
-         (lambda (store . args)
-           (format (current-error-port)
-                   "error: trying to build things during evaluation!~%")
-           (format (current-error-port)
-                   "'build-things' arguments: ~s~%" args)
-           (exit 1)))
+       ;; 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 the entry point of FILE and print the resulting job sexp.
-       (pretty-print
-        (match ((module-ref %user-module 'hydra-jobs) store '())
-          (((names . thunks) ...)
-           (map (lambda (job thunk)
-                  (format (current-error-port) "evaluating '~a'... " job)
-                  (force-output (current-error-port))
-                  (cons job
-                        (assert-valid-job job
-                                          (call-with-time-display thunk))))
-                names thunks)))
-        port))))
+           ;; Call the entry point of FILE and print the resulting job sexp.
+           (pretty-print
+            (match ((module-ref %user-module
+                                (if (equal? cuirass? "cuirass")
+                                    'cuirass-jobs
+                                    'hydra-jobs))
+                    store `((guix
+                             . ((file-name . ,source)))))
+              (((names . thunks) ...)
+               (map (lambda (job thunk)
+                      (format (current-error-port) "evaluating '~a'... " job)
+                      (force-output (current-error-port))
+                      (cons job
+                            (assert-valid-job job
+                                              (call-with-time-display thunk))))
+                    names thunks)))
+            port))))))
   ((command _ ...)
-   (format (current-error-port) "Usage: ~a FILE
-Evaluate the Hydra jobs defined in FILE.~%"
+   (format (current-error-port) "Usage: ~a FILE [cuirass]
+Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
            command)
    (exit 1)))