me
/
guix
Archived
1
0
Fork 0
Code

guix package: Separate '--remove' option processing. 

* guix/scripts/package.scm (options->removable): New procedure.
  (guix-package)[process-actions]: Use it.  Rename 'remove*' to 'remove'
  and 'install*' to 'install'.
master
Ludovic Courtès 2013-11-01 17:12:15 +01:00
parent 2876b98925
commit 537630c5a7
1 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
guix/scripts/package.scm
View File

@ -692,6 +692,17 @@ return the new list of manifest entries."
(append to-upgrade to-install)) (append to-upgrade to-install))
(define (options->removable options manifest)
"Given options, return the list of manifest entries to be removed from
MANIFEST."
(let ((remove (filter-map (match-lambda
(('remove . package)
package)
(_ #f))
options)))
(filter (cut manifest-installed? manifest <>)
remove)))
;;; ;;;
;;; Entry point. ;;; Entry point.
@ -839,16 +850,10 @@ more information.~%"))
opts)) opts))
(else (else
(let* ((manifest (profile-manifest profile)) (let* ((manifest (profile-manifest profile))
(install* (options->installable opts manifest)) (install (options->installable opts manifest))
(remove (filter-map (match-lambda (remove (options->removable opts manifest))
(('remove . package)
package)
(_ #f))
opts))
(remove* (filter (cut manifest-installed? manifest <>)
remove))
(entries (entries
(append install* (append install
(fold (lambda (package result) (fold (lambda (package result)
(match package (match package
(($ <manifest-entry> name _ out _ ...) (($ <manifest-entry> name _ out _ ...)
@ -858,7 +863,7 @@ more information.~%"))
result)))) result))))
(manifest-entries (manifest-entries
(manifest-remove manifest remove)) (manifest-remove manifest remove))
install*))) install)))
(new (make-manifest entries))) (new (make-manifest entries)))
(when (equal? profile %current-profile) (when (equal? profile %current-profile)
@ -867,7 +872,7 @@ more information.~%"))
(if (manifest=? new manifest) (if (manifest=? new manifest)
(format (current-error-port) (_ "nothing to be done~%")) (format (current-error-port) (_ "nothing to be done~%"))
(let ((prof-drv (profile-derivation (%store) new))) (let ((prof-drv (profile-derivation (%store) new)))
(show-what-to-remove/install remove* install* dry-run?) (show-what-to-remove/install remove install dry-run?)
(show-what-to-build (%store) (list prof-drv) (show-what-to-build (%store) (list prof-drv)
#:use-substitutes? #:use-substitutes?
(assoc-ref opts 'substitutes?) (assoc-ref opts 'substitutes?)