nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2013-01-15 22:39:03 +01:00
parent acf60b26bd
commit c4d645341b
1 changed files with 20 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
guix-package.in
View File

@ -52,7 +52,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
#:export (guix-package)) #:export (guix-package))
(define %store (define %store
(open-connection)) (make-parameter #f))
;;; ;;;
@ -277,7 +277,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(define (guile-missing?) (define (guile-missing?)
;; Return #t if %GUILE-FOR-BUILD is not available yet. ;; Return #t if %GUILE-FOR-BUILD is not available yet.
(let ((out (derivation-path->output-path (%guile-for-build)))) (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?) (define (show-what-to-build drv dry-run?)
;; Show what will/would be built in realizing the derivations listed ;; 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* ((req (append-map (lambda (drv-path)
(let ((d (call-with-input-file drv-path (let ((d (call-with-input-file drv-path
read-derivation))) read-derivation)))
(derivation-prerequisites-to-build %store d))) (derivation-prerequisites-to-build
(%store) d)))
drv)) drv))
(req* (delete-duplicates (req* (delete-duplicates
(append (remove (compose (cut valid-path? %store <>) (append (remove (compose (cute valid-path? (%store) <>)
derivation-path->output-path) derivation-path->output-path)
drv) drv)
(map derivation-input-path req))))) (map derivation-input-path req)))))
@ -374,7 +375,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(drv (filter-map (match-lambda (drv (filter-map (match-lambda
((name version sub-drv ((name version sub-drv
(? package? package)) (? package? package))
(package-derivation %store package)) (package-derivation (%store) package))
(_ #f)) (_ #f))
install)) install))
(install* (append (install* (append
@ -417,11 +418,11 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(show-what-to-build drv dry-run?) (show-what-to-build drv dry-run?)
(or dry-run? (or dry-run?
(and (build-derivations %store drv) (and (build-derivations (%store) drv)
(let* ((prof-drv (profile-derivation %store packages)) (let* ((prof-drv (profile-derivation (%store) packages))
(prof (derivation-path->output-path prof-drv)) (prof (derivation-path->output-path prof-drv))
(old-drv (profile-derivation (old-drv (profile-derivation
%store (manifest-packages (%store) (manifest-packages
(profile-manifest profile)))) (profile-manifest profile))))
(old-prof (derivation-path->output-path old-drv)) (old-prof (derivation-path->output-path old-drv))
(number (latest-profile-number profile)) (number (latest-profile-number profile))
@ -436,7 +437,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(if (or verbose? (guile-missing?)) (if (or verbose? (guile-missing?))
(current-error-port) (current-error-port)
(%make-void-port "w")))) (%make-void-port "w"))))
(build-derivations %store (list prof-drv))) (build-derivations (%store) (list prof-drv)))
(begin (begin
(symlink prof name) (symlink prof name)
(when (file-exists? profile) (when (file-exists? profile)
@ -490,11 +491,12 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)
(let ((opts (parse-options))) (let ((opts (parse-options)))
(parameterize ((%store (open-connection)))
(with-error-handling (with-error-handling
(or (process-query opts) (or (process-query opts)
(parameterize ((%guile-for-build (parameterize ((%guile-for-build
(package-derivation %store (package-derivation (%store)
(if (assoc-ref opts 'bootstrap?) (if (assoc-ref opts 'bootstrap?)
%bootstrap-guile %bootstrap-guile
guile-final)))) guile-final))))
(process-actions opts)))))) (process-actions opts)))))))