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/cuirass.in  | 14 ++++----------
 bin/evaluate.in | 29 ++++++++++++++++++++---------
 2 files changed, 24 insertions(+), 19 deletions(-)

(limited to 'bin')

diff --git a/bin/cuirass.in b/bin/cuirass.in
index fb4023c..5f89379 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -87,13 +87,11 @@ if required."
                                           (assq-ref spec #:name) "/"
                                           (assq-ref spec #:load-path))
                            (%package-cachedir)
-                           (object->string spec)))
+                           (object->string spec)
+                           (%package-database)))
          (jobs (read port)))
     (close-pipe port)
-    ;; Keep track of SPEC id in the returned jobs.
-    (let ((spec-id (assq-ref spec #:id)))
-      (map (λ (job) (acons #:spec-id spec-id job))
-           jobs))))
+    jobs))
 
 (define (build-packages store db jobs)
   "Build JOBS which is a list of <job> objects."
@@ -118,11 +116,7 @@ if required."
               (compile (string-append (%package-cachedir) "/"
                                       (assq-ref spec #:name)))
               (with-store store
-                (let* ((jobs (evaluate store db spec)))
-                  (for-each (λ (job)
-                              (or (evaluation-exists? db job)
-                                  (db-add-evaluation db job)))
-                            jobs)
+                (let ((jobs (evaluate store db spec)))
                   (set-build-options store #:use-substitutes? #f)
                   (build-packages store db jobs))))
             jobspecs))
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