summary refs log tree commit diff
path: root/guix/inferior.scm
diff options
context:
space:
mode:
authorKonrad Hinsen <konrad.hinsen@fastmail.net>2019-11-12 16:39:46 +0100
committerLudovic Courtès <ludo@gnu.org>2019-11-15 23:28:17 +0100
commit1d5485690ba75d6b355fd519caf40881a606678b (patch)
tree5698da3ac822254dd9c273eb751c2cd982ec990a /guix/inferior.scm
parentf675f8dec73d02e319e607559ed2316c299ae8c7 (diff)
downloadguix-1d5485690ba75d6b355fd519caf40881a606678b.tar.gz
inferior: 'cached-channel-instance' takes an open store connection.
* guix/inferior.scm (cached-channel-instance): Take an explicit 'store'
argument.
(inferior-for-channels): Wrap call to 'cached-channel-instance' in
'with-store'.
* guix/time-machine.scm (guix-time-machine): Wrap call to
'cached-channel-instance' in 'with-store'.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'guix/inferior.scm')
-rw-r--r--guix/inferior.scm99
1 files changed, 50 insertions, 49 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm
index be50e0ec26..71dae89e92 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -636,58 +636,57 @@ failing when GUIX is too old and lacks the 'guix repl' command."
   (make-parameter (string-append (cache-directory #:ensure? #f)
                                  "/inferiors")))
 
-(define* (cached-channel-instance channels
+(define* (cached-channel-instance store
+                                  channels
                                   #:key
                                   (cache-directory (%inferior-cache-directory))
                                   (ttl (* 3600 24 30)))
   "Return a directory containing a guix filetree defined by CHANNELS, a list of channels.
 The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.
 This procedure opens a new connection to the build daemon."
-  (with-store store
-    (let ()
-      (define instances
-        (latest-channel-instances store channels))
-
-      (define key
-        (bytevector->base32-string
-         (sha256
-          (string->utf8
-           (string-concatenate (map channel-instance-commit instances))))))
-
-      (define cached
-        (string-append cache-directory "/" key))
-
-      (define (base32-encoded-sha256? str)
-        (= (string-length str) 52))
-
-      (define (cache-entries directory)
-        (map (lambda (file)
-               (string-append directory "/" file))
-             (scandir directory base32-encoded-sha256?)))
-
-      (define symlink*
-        (lift2 symlink %store-monad))
-
-      (define add-indirect-root*
-        (store-lift add-indirect-root))
-
-      (mkdir-p cache-directory)
-      (maybe-remove-expired-cache-entries cache-directory
-                                          cache-entries
-                                          #:entry-expiration
-                                          (file-expiration-time ttl))
-
-      (if (file-exists? cached)
-          cached
-          (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))
-                (symlink* (derivation->output-path profile) cached)
-                (add-indirect-root* cached)
-                (return cached))))))))
+  (define instances
+    (latest-channel-instances store channels))
+
+  (define key
+    (bytevector->base32-string
+     (sha256
+      (string->utf8
+       (string-concatenate (map channel-instance-commit instances))))))
+
+  (define cached
+    (string-append cache-directory "/" key))
+
+  (define (base32-encoded-sha256? str)
+    (= (string-length str) 52))
+
+  (define (cache-entries directory)
+    (map (lambda (file)
+           (string-append directory "/" file))
+         (scandir directory base32-encoded-sha256?)))
+
+  (define symlink*
+    (lift2 symlink %store-monad))
+
+  (define add-indirect-root*
+    (store-lift add-indirect-root))
+
+  (mkdir-p cache-directory)
+  (maybe-remove-expired-cache-entries cache-directory
+                                      cache-entries
+                                      #:entry-expiration
+                                      (file-expiration-time ttl))
+
+  (if (file-exists? cached)
+      cached
+      (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))
+            (symlink* (derivation->output-path profile) cached)
+            (add-indirect-root* cached)
+            (return cached))))))
 
 (define* (inferior-for-channels channels
                                 #:key
@@ -700,7 +699,9 @@ procedure opens a new connection to the build daemon.
 This is a convenience procedure that people may use in manifests passed to
 'guix package -m', for instance."
   (define cached
-    (cached-channel-instance channels
-                             #:cache-directory cache-directory
-                             #:ttl ttl))
+    (with-store store
+      (cached-channel-instance store
+                               channels
+                               #:cache-directory cache-directory
+                               #:ttl ttl)))
   (open-inferior cached))