From 0a4209c49eac41b728500fbdfa17f38aa2a4d210 Mon Sep 17 00:00:00 2001
From: Vincent Legoll <address@hidden>
Date: Tue, 23 Aug 2016 15:06:12 +0200
Subject: [PATCH] Add --nodownload CLI option

* guix/scripts/pull.scm (show-help, %option): add new option
                        (guix-pull): handle --nodownload option
                        (build-and-install): add store parameter,
                                             create $STORE/latest symlink

Signed-off-by: Vincent Legoll <address@hidden>
---
 guix/scripts/pull.scm | 36 ++++++++++++++++++++++++------------
 1 file changed, 24 insertions(+), 12 deletions(-)

diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index a4824e4..e7775c0 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -79,6 +79,8 @@ Download and deploy the latest version of Guix.\n"))
       --url=URL          download the Guix tarball from URL"))
   (display (_ "
       --bootstrap        use the bootstrap Guile to build the new Guix"))
+  (display (_ "
+      --nodownload       only switch to the last downloaded version of Guix"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -99,6 +101,9 @@ Download and deploy the latest version of Guix.\n"))
         (option '("bootstrap") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'bootstrap? #t result)))
+        (option '("nodownload") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'nodownload? #t result)))
 
         (option '(#\h "help") #f #f
                 (lambda args
@@ -184,7 +189,7 @@ contained therein."
     ;; tree.
     (build source #:verbose? verbose?)))
 
-(define* (build-and-install tarball config-dir
+(define* (build-and-install tarball config-dir store
                             #:key verbose?)
   "Build the tool from TARBALL, and install it in CONFIG-DIR."
   (mlet* %store-monad ((source        (build-from-source tarball
@@ -197,6 +202,7 @@ contained therein."
     (if built?
         (mlet* %store-monad
             ((latest -> (string-append config-dir "/latest"))
+             (latest-in-store -> (string-append store "/latest"))
              (done      (indirect-root-added latest)))
           (if (and (file-exists? latest)
                    (string=? (readlink latest) source-dir))
@@ -205,6 +211,7 @@ contained therein."
                 (return #t))
               (begin
                 (switch-symlinks latest source-dir)
+                (switch-symlinks latest-in-store source-dir)
                 (format #t
                         (_ "updated ~a successfully deployed under `~a'~%")
                         %guix-package-name latest)
@@ -224,18 +231,23 @@ contained therein."
   (with-error-handling
     (let* ((opts  (parse-options))
            (store (open-connection))
+           (config-dir (config-directory))
            (url   (assoc-ref opts 'tarball-url)))
-      (let ((tarball (download-to-store store url "guix-latest.tar.gz")))
-        (unless tarball
-          (leave (_ "failed to download up-to-date source, exiting\n")))
-        (parameterize ((%guile-for-build
-                        (package-derivation store
-                                            (if (assoc-ref opts 'bootstrap?)
-                                                %bootstrap-guile
-                                                (canonical-package guile-2.0)))))
-          (run-with-store store
-            (build-and-install tarball (config-directory)
-                               #:verbose? (assoc-ref opts 'verbose?))))))))
+      (if (assoc-ref opts 'nodownload?)
+          (let ((latest -> (string-append config-dir "/latest"))
+                (latest-in-store -> (string-append store "/latest")))
+            (switch-symlinks latest latest-in-store))
+          (let ((tarball (download-to-store store url "guix-latest.tar.gz")))
+            (unless tarball
+              (leave (_ "failed to download up-to-date source, exiting\n")))
+            (parameterize ((%guile-for-build
+                            (package-derivation store
+                                                (if (assoc-ref opts 'bootstrap?)
+                                                    %bootstrap-guile
+                                                    (canonical-package guile-2.0)))))
+              (run-with-store store
+                (build-and-install tarball config-dir store
+                                   #:verbose? (assoc-ref opts 'verbose?)))))))))
 
 ;; Local Variables:
 ;; eval: (put 'with-PATH 'scheme-indent-function 1)
-- 
1.9.1