WIPfetching-substitutes-without-caching

1 files changed, 24 insertions, 12 deletions

diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index b7d8165262..70eca6ef6d 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -187,7 +187,8 @@ or #f if it could not be determined."
      #f)))
 
 (define* (report-server-coverage server items
-                                 #:key display-missing?)
+                                 #:key display-missing?
+                                 (use-cache? #t))
   "Report the subset of ITEMS available as substitutes on SERVER.
 When DISPLAY-MISSING? is true, display the list of missing substitutes.
 Return the coverage ratio, an exact number between 0 and 1.
@@ -204,7 +205,8 @@ In case ITEMS is an empty list, return 1 instead."
                     server items
                     #:make-progress-reporter
                     (lambda* (total #:key url #:allow-other-keys)
-                      (progress-reporter/bar total)))))
+                      (progress-reporter/bar total))
+                    #:use-cache? use-cache?)))
     (format #t (highlight "~a~%") server)
     (let ((obtained  (length narinfos))
           (requested (length items))
@@ -381,10 +383,14 @@ Report the availability of substitutes.\n"))
          (option '("display-missing") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'display-missing? #t result)))
+         (option '(#\n "no-cache") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'use-cache? #f result)))
          %standard-native-build-options))
 
 (define %default-options
-  `((substitute-urls . ,%default-substitute-urls)))
+  `((substitute-urls . ,%default-substitute-urls)
+    (use-cache?      . #t)))
 
 (define (load-manifest file)
   "Load the manifest from FILE and return the list of packages it refers to."
@@ -451,19 +457,20 @@ store file names for SYSTEM."
          vlist-null
          packages))
 
-(define (substitute-oracle server items)
+(define* (substitute-oracle server items #:key (use-cache? #t))
   "Return a procedure that, when passed a store item (one of those listed in
 ITEMS), returns true if SERVER has a substitute for it, false otherwise."
   (define available
     (fold (lambda (narinfo set)
             (set-insert (narinfo-path narinfo) set))
           (set)
-          (lookup-narinfos server items)))
+          (lookup-narinfos server items #:use-cache? use-cache?)))
 
   (cut set-contains? available <>))
 
 (define* (report-package-coverage-per-system server packages system
-                                             #:key (threshold 0))
+                                             #:key (threshold 0)
+                                             (use-cache? #t))
   "Report on the subset of PACKAGES that lacks SYSTEM substitutes on SERVER,
 sorted by decreasing number of dependents.  Do not display those with less
 than THRESHOLD dependents."
@@ -477,7 +484,7 @@ than THRESHOLD dependents."
                   mapping))
 
     (define substitutable?
-      (substitute-oracle server items))
+      (substitute-oracle server items #:use-cache? use-cache?))
 
     (define substitutable-package?
       (lambda (package)
@@ -529,7 +536,8 @@ which:~%"
     (return #t)))
 
 (define* (report-package-coverage server packages systems
-                                  #:key (threshold 0))
+                                  #:key (threshold 0)
+                                  (use-cache? #t))
   "Report on the substitute coverage for PACKAGES, for each of SYSTEMS, on
 SERVER.  Display information for packages with at least THRESHOLD dependents."
   (with-store store
@@ -537,7 +545,8 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
       (foldm %store-monad
              (lambda (system _)
                (report-package-coverage-per-system server packages system
-                                                   #:threshold threshold))
+                                                   #:threshold threshold
+                                                   #:use-cache? use-cache?))
              #f
              systems))))
 
@@ -595,7 +604,9 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
                    (define coverage
                      (report-server-coverage server items
                                              #:display-missing?
-                                             (assoc-ref opts 'display-missing?)))
+                                             (assoc-ref opts 'display-missing?)
+                                             #:use-cache?
+                                             (assq-ref opts 'use-cache?)))
                    (match (assoc-ref opts 'coverage)
                      (#f #f)
                      (threshold
@@ -604,8 +615,9 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
                       (report-package-coverage server
                                                (filter package? packages)
                                                systems
-                                               #:threshold threshold)))
-
+                                               #:threshold threshold
+                                               #:use-cache?
+                                               (assq-ref opts 'use-cache?))))
                    (= 1 coverage))
                  urls))))))