[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: Fix evaluation.
From: |
Mathieu Othacehe |
Subject: |
branch master updated: Fix evaluation. |
Date: |
Wed, 10 Mar 2021 13:24:46 -0500 |
This is an automated email from the git hooks/post-receive script.
mothacehe pushed a commit to branch master
in repository guix-cuirass.
The following commit(s) were added to refs/heads/master by this push:
new 88f3cf6 Fix evaluation.
88f3cf6 is described below
commit 88f3cf65e0b5974c6525d498ebffc607bc62baf0
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Mar 10 19:24:34 2021 +0100
Fix evaluation.
* bin/evaluate.in: Fix it.
---
bin/evaluate.in | 36 ++++++++++++++----------------------
1 file changed, 14 insertions(+), 22 deletions(-)
diff --git a/bin/evaluate.in b/bin/evaluate.in
index 4569581..b955dfc 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -28,9 +28,12 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(use-modules (cuirass database)
(cuirass specification)
(guix channels)
+ (guix derivations)
(guix inferior)
(guix licenses)
+ (guix monads)
(guix store)
+ (guix ui)
(guix utils)
(srfi srfi-1)
(ice-9 match)
@@ -79,27 +82,17 @@ Pass the BUILD, CHANNELS and SYSTEMS arguments to the
EVAL-PROC procedure."
(,eval-proc store ',args)))))
(db-register-builds jobs eval-id spec))))
-(define (channels->cached-profile channels checkouts)
- "Return a directory containing a guix filetree defined by CHANNELS, a list
-of channels. Pin the given channels to the commits specified in CHECKOUTS."
- (define (checkout->commit name)
- (any (lambda (checkout)
- (and (eq? (assq-ref checkout #:channel) name)
- (assq-ref checkout #:commit)))
- checkouts))
-
+(define (channel-instances->profile instances)
+ "Return a directory containing a guix filetree defined by INSTANCES, a list
+of channel instances."
(with-store store
- (set-build-options store
- #:use-substitutes? #f
- #:substitute-urls '())
- (let ((channels*
- (map (lambda (c)
- (let ((name (channel-name c)))
- (channel
- (inherit c)
- (commit (checkout->commit name)))))
- channels)))
- (cached-channel-instance store channels*))))
+ (run-with-store store
+ (mlet* %store-monad ((profile
+ (channel-instances->derivation instances)))
+ (mbegin %store-monad
+ (show-what-to-build* (list profile))
+ (built-derivations (list profile))
+ (return (derivation->output-path profile)))))))
(define* (main #:optional (args (command-line)))
"This procedure spawns an inferior on the given channels. An evaluation
@@ -114,8 +107,7 @@ registered in database."
(spec (db-get-specification name))
(checkouts (db-get-checkouts eval-id))
(instances (checkouts->channel-instances checkouts))
- (channels (specification-channels spec))
- (profile (channels->cached-profile channels checkouts))
+ (profile (channel-instances->profile instances))
(build (specification-build spec))
(systems (specification-systems spec)))