04/07: inferior: Break cached-channel-instance into two procedures.

[guix-commits]

mothacehe pushed a commit to branch master
in repository guix.

commit 7d63b775513e7049047222dbe403a4181f63828d
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Mar 5 09:51:42 2021 +0100

    inferior: Break cached-channel-instance into two procedures.
    
    Break cached-channel-instance into two different procedures:
    channels->cached-profile and instances->cached-profile operating 
respectively
    on channels and channels instances.
    
    * guix/inferior.scm (cached-channel-instance): Rename it into ...
    (cached-profile): ... this new procedure.
    (channels->cached-profile, instances->cached-profile): New procedures.
    * guix/scripts/time-machine.scm (guix-time-machine): Adapt accordingly.
---
 guix/inferior.scm             | 82 +++++++++++++++++++++++++++++--------------
 guix/scripts/time-machine.scm |  5 +--
 2 files changed, 58 insertions(+), 29 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 0990696..714e1e1 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -98,7 +98,8 @@
             gexp->derivation-in-inferior
 
             %inferior-cache-directory
-            cached-channel-instance
+            channels->cached-profile
+            instances->cached-profile
             inferior-for-channels))
 
 ;;; Commentary:
@@ -708,22 +709,14 @@ prefix, resolve it; and if 'commit' is unset, fetch 
CHANNEL's branch tip."
                                              #:check-out? #f)))
           commit))))
 
-(define* (cached-channel-instance store
-                                  channels
-                                  #:key
-                                  (authenticate? #t)
-                                  (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.  AUTHENTICATE?
-determines whether CHANNELS are authenticated."
-  (define commits
-    ;; Since computing the instances of CHANNELS is I/O-intensive, use a
-    ;; cheaper way to get the commit list of CHANNELS.  This limits overhead
-    ;; to the minimum in case of a cache hit.
-    (map channel-full-commit channels))
-
+(define* (cached-profile store instances
+                         #:key
+                         cache-directory
+                         commits ttl)
+  "Return a directory containing a guix filetree defined by INSTANCES, a
+procedure returning a list of channel instances.  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."
   (define key
     (bytevector->base32-string
      (sha256
@@ -755,12 +748,8 @@ determines whether CHANNELS are authenticated."
   (if (file-exists? cached)
       cached
       (run-with-store store
-        (mlet* %store-monad ((instances
-                              -> (latest-channel-instances store channels
-                                                           #:authenticate?
-                                                           authenticate?))
-                             (profile
-                              (channel-instances->derivation instances)))
+        (mlet* %store-monad ((profile
+                              (channel-instances->derivation (instances))))
           (mbegin %store-monad
             (show-what-to-build* (list profile))
             (built-derivations (list profile))
@@ -770,6 +759,45 @@ determines whether CHANNELS are authenticated."
             (add-indirect-root* cached)
             (return cached))))))
 
+(define* (channels->cached-profile store channels
+                                   #:key
+                                   (authenticate? #t)
+                                   (cache-directory
+                                    (%inferior-cache-directory))
+                                   (ttl (* 3600 24 30)))
+  "Return a cached profile from CHANNELS using the CACHED-PROFILE procedure.
+AUTHENTICATE? determines whether CHANNELS are authenticated."
+  (define commits
+    ;; Since computing the instances of CHANNELS is I/O-intensive, use a
+    ;; cheaper way to get the commit list of CHANNELS.  This limits overhead
+    ;; to the minimum in case of a cache hit.
+    (map channel-full-commit channels))
+
+  (define instances
+    (lambda ()
+      (latest-channel-instances store channels
+                                #:authenticate? authenticate?)))
+
+  (cached-profile store instances
+                  #:cache-directory cache-directory
+                  #:commits commits
+                  #:ttl ttl))
+
+(define* (instances->cached-profile store instances
+                                    #:key
+                                    (cache-directory
+                                     (%inferior-cache-directory))
+                                    (ttl (* 3600 24 30)))
+  "Return a cached profile from INSTANCES a list of channel instances using
+the CACHED-PROFILE procedure."
+  (define commits
+    (map channel-instance-commit instances))
+
+  (cached-profile store (lambda () instances)
+                  #:cache-directory cache-directory
+                  #:commits commits
+                  #:ttl ttl))
+
 (define* (inferior-for-channels channels
                                 #:key
                                 (cache-directory (%inferior-cache-directory))
@@ -782,10 +810,10 @@ This is a convenience procedure that people may use in 
manifests passed to
 'guix package -m', for instance."
   (define cached
     (with-store store
-      (cached-channel-instance store
-                               channels
-                               #:cache-directory cache-directory
-                               #:ttl ttl)))
+      (channels->cached-profile store
+                                channels
+                                #:cache-directory cache-directory
+                                #:ttl ttl)))
   (open-inferior cached))
 
 ;;; Local Variables:
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 0d27414..c4dca47 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -142,7 +142,8 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
                  (with-store store
                    (with-status-verbosity (assoc-ref opts 'verbosity)
                      (set-build-options-from-command-line store opts)
-                     (cached-channel-instance store channels
-                                              #:authenticate? authenticate?))))
+                     (channels->cached-profile
+                      store channels
+                      #:authenticate? authenticate?))))
                 (executable (string-append directory "/bin/guix")))
            (apply execl (cons* executable executable command-line))))))))