From fccd6fa60b0a2345b5ea1c68ca07c443a03b7109 Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
Date: Sun, 24 Jul 2016 17:48:03 +0200
Subject: evaluate: Store evaluations in evaluate script.

---
 bin/evaluate.in | 29 ++++++++++++++++++++---------
 1 file changed, 20 insertions(+), 9 deletions(-)

(limited to 'bin/evaluate.in')

diff --git a/bin/evaluate.in b/bin/evaluate.in
index 99124f3..878732f 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -24,6 +24,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
 ;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
 
 (use-modules (cuirass base)
+             (cuirass database)
              (cuirass utils)
              (ice-9 match)
              (ice-9 pretty-print)
@@ -31,7 +32,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
 
 (define* (main #:optional (args (command-line)))
   (match args
-    ((command load-path cachedir specstr)
+    ((command load-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))
@@ -54,15 +55,25 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
                           stderr)
                  (simple-format stderr "'build-things' arguments: ~S~%" args)
                  (exit 1)))
-         ;; Call the entry point of FILE and print the resulting job sexp.
-         (pretty-print
-          (let* ((proc   (module-ref %user-module 'hydra-jobs) )
-                 (thunks (proc store (assq-ref spec #:arguments))))
-            (map (λ (thunk) (call-with-time-display thunk))
-                 thunks))
-          stdout))))
+         (parameterize ((%package-database database))
+           ;; Call the entry point of FILE and print the resulting job sexp.
+           (let* ((proc   (module-ref %user-module 'hydra-jobs))
+                  (thunks (proc store (assq-ref spec #:arguments)))
+                  (db     (db-open))
+                  (spec-id (assq-ref spec #:id)))
+             (pretty-print
+              (map (λ (thunk)
+                     (let* ((job  (call-with-time-display thunk))
+                            ;; Keep track of SPEC id in the returned jobs.
+                            (job* (acons #:spec-id spec-id job)))
+                       (or (evaluation-exists? db job*)
+                           (db-add-evaluation 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)
+                    command)
      (exit 1))))
-- 
cgit v1.2.3