summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-01-15 22:39:03 +0100
committerLudovic Courtès <ludo@gnu.org>2013-01-15 22:39:03 +0100
commitc4d645341be8e04f4f4d3fcff140002e5e558f5f (patch)
tree7bf956a1bcf53d1004becea2d5edc97d93247397
parentacf60b26bde717a9717ed519aa73e261ad71e1db (diff)
downloadguix-c4d645341be8e04f4f4d3fcff140002e5e558f5f.tar.gz
guix-package: Connect to the daemon only after arguments have been processed.
* guix-package.in (%store): Change to a SRFI-39 parameter.  Update all users.
  (guix-package): Parametrize %STORE to an open connection after
  `parse-options' has been called.
-rw-r--r--guix-package.in38
1 files changed, 20 insertions, 18 deletions
diff --git a/guix-package.in b/guix-package.in
index 3e98239e28..c3fc397e5c 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -52,7 +52,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   #:export (guix-package))
 
 (define %store
-  (open-connection))
+  (make-parameter #f))
 
 
 ;;;
@@ -277,7 +277,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (define (guile-missing?)
     ;; Return #t if %GUILE-FOR-BUILD is not available yet.
     (let ((out (derivation-path->output-path (%guile-for-build))))
-      (not (valid-path? %store out))))
+      (not (valid-path? (%store) out))))
 
   (define (show-what-to-build drv dry-run?)
     ;; Show what will/would be built in realizing the derivations listed
@@ -285,10 +285,11 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
     (let* ((req  (append-map (lambda (drv-path)
                                (let ((d (call-with-input-file drv-path
                                           read-derivation)))
-                                 (derivation-prerequisites-to-build %store d)))
+                                 (derivation-prerequisites-to-build
+                                  (%store) d)))
                              drv))
            (req* (delete-duplicates
-                  (append (remove (compose (cut valid-path? %store <>)
+                  (append (remove (compose (cute valid-path? (%store) <>)
                                            derivation-path->output-path)
                                   drv)
                           (map derivation-input-path req)))))
@@ -374,7 +375,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
            (drv      (filter-map (match-lambda
                                   ((name version sub-drv
                                          (? package? package))
-                                   (package-derivation %store package))
+                                   (package-derivation (%store) package))
                                   (_ #f))
                                  install))
            (install* (append
@@ -417,12 +418,12 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
       (show-what-to-build drv dry-run?)
 
       (or dry-run?
-          (and (build-derivations %store drv)
-               (let* ((prof-drv (profile-derivation %store packages))
+          (and (build-derivations (%store) drv)
+               (let* ((prof-drv (profile-derivation (%store) packages))
                       (prof     (derivation-path->output-path prof-drv))
                       (old-drv  (profile-derivation
-                                 %store (manifest-packages
-                                         (profile-manifest profile))))
+                                 (%store) (manifest-packages
+                                           (profile-manifest profile))))
                       (old-prof (derivation-path->output-path old-drv))
                       (number   (latest-profile-number profile))
                       (name     (format #f "~a/~a-~a-link"
@@ -436,7 +437,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                           (if (or verbose? (guile-missing?))
                                               (current-error-port)
                                               (%make-void-port "w"))))
-                            (build-derivations %store (list prof-drv)))
+                            (build-derivations (%store) (list prof-drv)))
                           (begin
                             (symlink prof name)
                             (when (file-exists? profile)
@@ -490,11 +491,12 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (setvbuf (current-error-port) _IOLBF)
 
   (let ((opts (parse-options)))
-    (with-error-handling
-      (or (process-query opts)
-          (parameterize ((%guile-for-build
-                          (package-derivation %store
-                                              (if (assoc-ref opts 'bootstrap?)
-                                                  %bootstrap-guile
-                                                  guile-final))))
-            (process-actions opts))))))
+    (parameterize ((%store (open-connection)))
+      (with-error-handling
+        (or (process-query opts)
+            (parameterize ((%guile-for-build
+                            (package-derivation (%store)
+                                                (if (assoc-ref opts 'bootstrap?)
+                                                    %bootstrap-guile
+                                                    guile-final))))
+              (process-actions opts)))))))