diff options
| -rw-r--r-- | guix/inferior.scm | 82 | ||||
| -rw-r--r-- | guix/scripts/time-machine.scm | 5 |
2 files changed, 58 insertions, 29 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm index 0990696e6c..714e1e1eae 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 0d27414702..c4dca47d1d 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)))))))) |