cuirass/bin/evaluate.in

#!/bin/sh
# -*- scheme -*-
# @configure_input@
GUILE_LOAD_PATH="$1${GUILE_LOAD_PATH:+:}$GUILE_LOAD_PATH"
export GUILE_LOAD_PATH
exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
!#
;;;; evaluate -- convert a specification to a job list
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
;;; Cuirass 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.
;;;
;;; Cuirass 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 Cuirass.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (cuirass)
             (cuirass utils)
             (ice-9 match)
             (ice-9 pretty-print)
             (guix store))

(define* (main #:optional (args (command-line)))
  (match args
    ((command load-path guix-package-path cachedir specstr database)
     ;; Load FILE, a Scheme file that defines Hydra jobs.
     (let ((%user-module (make-fresh-user-module))
           (spec         (with-input-from-string specstr read))
           (stdout       (current-output-port))
           (stderr       (current-error-port)))
       (save-module-excursion
        (λ ()
          (set-current-module %user-module)
          (with-directory-excursion
              (string-append cachedir "/" (assq-ref spec #:name))
            (primitive-load (assq-ref spec #:file)))))
       (with-store store
         (unless (assoc-ref spec #:use-substitutes?)
           ;; 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
               (λ (store . args)
                 (display "error: trying to build things during evaluation!~%"
                          stderr)
                 (simple-format stderr "'build-things' arguments: ~S~%" args)
                 (exit 1)))
         (parameterize ((%package-database database)
                        (%use-substitutes? (assoc-ref spec #:use-substitutes?)))
           (unless (string-null? guix-package-path)
             (set-guix-package-path! guix-package-path))
           ;; Call the entry point of FILE and print the resulting job sexp.
           (let* ((proc-name (assq-ref spec #:proc))
                  (proc    (module-ref %user-module proc-name))
                  (thunks  (proc store (assq-ref spec #:arguments)))
                  (db      (db-open))
                  (commit  (assq-ref spec #:current-commit))
                  (eval    `((#:specification . ,(assq-ref spec #:name))
                             (#:revision . ,commit)))
                  (eval-id (db-add-evaluation db eval)))
             (pretty-print
              (map (λ (thunk)
                     (let* ((job  (call-with-time-display thunk))
                            ;; Keep track of SPEC id in the returned jobs.
                            (job* (acons #:eval-id eval-id job)))
                       (db-add-derivation db job*)
                       job*))
                   thunks)
              stdout)
             (db-close db))))))
    ((command _ ...)
     (simple-format (current-error-port) "Usage: ~A FILE
Evaluate the Hydra jobs defined in FILE.~%"
                    command)
     (exit 1))))