Add cache compacted manifests

guix/rustup/build/manifest.scm

@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (rustup build manifest)
+  #:use-module (rustup packages)
   #:use-module (rnrs enums)
   #:use-module (guix records)
   #:use-module (guix base32)
@@ -45,6 +46,7 @@
             download-manifest
             compact-manifest
             download-and-compact-manifest
+            write-manifest
             %rustc-target-triplets?
             %toolchain-components
             %toolchain-components?
@@ -475,8 +477,10 @@
 (define* (download-and-compact-manifest str)
   (let ((manifest (download-manifest str)))
     (if manifest
-        (compact-manifest str manifest)
-      #f)))
+        (let ((compacted (compact-manifest str manifest)))
+          (write-manifest compacted (manifests-directory-cache-directory))
+          compacted)
+        #f)))
 
 (define* (download-manifest str)
   (define c (channel->from-str str))
@@ -623,3 +627,45 @@
 
          )
     `(,url . ,hash)))
+
+(define* (write-manifest data manifests-dir
+                         #:optional (no-update-default-channel #t))
+  (define (channel version)
+    (cond ((string-contains version "beta")
+           "beta")
+          ((string-contains version "nightly")
+           "nightly")
+          (else
+           "stable")))
+
+  (let* ((version (car data))
+         (date (cadr data))
+         (channel (channel version))
+         (filename (format #f "~a~a-~a" manifests-dir channel date)))
+    (call-with-output-file filename
+      (lambda (port)
+        (write data port)))
+    (unless (string= channel "nightly")
+      (call-with-port
+          (open manifests-dir O_RDONLY)
+        (lambda (port)
+          (when (file-exists? (format #f "~a/~a" manifests-dir version))
+            (delete-file-at port version))
+          (symlinkat port (basename filename) version)
+          ;; (readlink version)
+          )))
+    (unless no-update-default-channel
+      (call-with-port
+          (open manifests-dir O_RDONLY)
+        (lambda (port)
+          (when (file-exists? (format #f "~a/~a" manifests-dir channel))
+            (delete-file-at port channel))
+          (symlinkat port (basename filename) channel)
+          ;; (readlink version)
+          )))
+    ;; (info (G_ "no update default channel '~a'...~%") no-update-default-channel)
+    ;; (info (G_ "version '~a'...~%") version)
+    ;; (info (G_ "date '~a'...~%") date)
+    ;; (info (G_ "filename '~a'...~%") filename)
+    )
+  )

guix/rustup/packages.scm

@@ -2,8 +2,11 @@
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix diagnostics)
+  #:use-module ((guix build utils) #:select (mkdir-p))
+  #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (search-manifest))
+  #:export (search-manifest
+            manifests-directory-cache-directory))
 
 (define %distro-root-directory
   ;; Absolute file name of the module hierarchy.  Since (gnu packages …) might
@@ -26,7 +29,7 @@
          ("rustup/packages.scm"      rustup/)
          ("rustup.scm"))))
 
-(define %manifest-path
+(define %manifests-directory
   ;; Define it after '%package-module-path' so that '%load-path' contains user
   ;; directories, allowing patches in $GUIX_PACKAGE_PATH to be found.
   (make-parameter
@@ -36,6 +39,32 @@
               directory))
         %load-path)))
 
+;; copied from (guix utils)
+(define* (xdg-directory variable suffix #:key (ensure? #t))
+  "Return the name of the XDG directory that matches VARIABLE and SUFFIX,
+after making sure that it exists if ENSURE? is true.  VARIABLE is an
+environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like
+\"/.config\".  Honor the XDG specs,
+<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
+  (let ((dir (and=> (or (getenv variable)
+                        (and=> (or (getenv "HOME")
+                                   (passwd:dir (getpwuid (getuid))))
+                               (cut string-append <> suffix)))
+                    (cut string-append <> "/guix-rustup"))))
+    (when ensure?
+      (mkdir-p dir))
+    dir))
+
+(define cache-directory
+  (cut xdg-directory "XDG_CACHE_HOME" "/.cache" <...>))
+
+(define* (manifests-directory-cache-directory #:key (ensure? #t))
+  (let ((dir (string-append (cache-directory) "/manifests/")))
+    (when ensure?
+      (mkdir-p dir))
+    dir))
+
 (define* (search-manifest file-name)
   "Search the manifest FILE-NAME.  Raise an error if not found."
-  (search-path (%manifest-path) file-name))
+  (or (search-path (%manifests-directory) file-name)
+      (search-path (list (manifests-directory-cache-directory)) file-name)))

scripts/update.scm

@@ -12,52 +12,14 @@
 
 (define %manifests-dir (string-append %root "/guix/rustup/manifests/"))
 
-(define (channel version)
-  (cond ((string-contains version "beta")
-                        "beta")
-                       ((string-contains version "nightly")
-                        "nightly")
-                       (else
-                        "stable")))
-
 (define (update arg0 . args)
   (when (nil? args)
     (error (G_ "No channel specified '~a'...~%") `(,arg0 ,@args)))
   (let* ((channel-str (car args))
          (no-update-default-channel (if (nil? (cdr args))
                                         #f
                                         (cadr args)))
-         (data (download-and-compact-manifest channel-str))
-         (version (car data))
-         (date (cadr data))
-         (channel (channel version))
-         (filename (format #f "~a~a-~a" %manifests-dir channel date)))
-    (call-with-output-file filename
-      (lambda (port)
-        (write data port)))
-    (unless (string= channel "nightly")
-      (call-with-port
-          (open %manifests-dir O_RDONLY)
-        (lambda (port)
-          (when (file-exists? (format #f "~a/~a" %manifests-dir version))
-            (delete-file-at port version))
-          (symlinkat port (basename filename) version)
-          ;; (readlink version)
-          )))
-    (unless no-update-default-channel
-      (call-with-port
-          (open %manifests-dir O_RDONLY)
-        (lambda (port)
-          (when (file-exists? (format #f "~a/~a" %manifests-dir channel))
-            (delete-file-at port channel))
-          (symlinkat port (basename filename) channel)
-          ;; (readlink version)
-          )))
-    ;; (info (G_ "no update default channel '~a'...~%") no-update-default-channel)
-    ;; (info (G_ "version '~a'...~%") version)
-    ;; (info (G_ "date '~a'...~%") date)
-    ;; (info (G_ "filename '~a'...~%") filename)
-    )
-  )
+         (data (download-and-compact-manifest channel-str)))
+    (write-manifest data %manifests-dir no-update-default-channel)))
 
 (apply update (command-line))