TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

guix package: Move 'process-actions' out of sight.

Browse source 
* guix/scripts/package.scm (process-actions): New procedure, moved
from...
(guix-package): ... here.  Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2015-11-30 21:18:11 +02:00
parent dfdb15d9c2
commit 6e37017506
1 changed files with 34 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
guix/scripts/package.scm
View file

@ -786,6 +786,39 @@ (define %actions
(delete-generations . ,delete-generations-action)
(manifest . ,manifest-action)))
(define (process-actions store opts)
"Process any install/remove/upgrade action from OPTS."
(define dry-run? (assoc-ref opts 'dry-run?))
(define bootstrap? (assoc-ref opts 'bootstrap?))
(define substitutes? (assoc-ref opts 'substitutes?))
(define profile (or (assoc-ref opts 'profile) %current-profile))
;; First, process roll-backs, generation removals, etc.
(for-each (match-lambda
((key . arg)
(and=> (assoc-ref %actions key)
(lambda (proc)
(proc store profile arg opts
#:dry-run? dry-run?)))))
opts)
;; Then, process normal package installation/removal/upgrade.
(let* ((manifest (profile-manifest profile))
(install (options->installable opts manifest))
(remove (options->removable opts manifest))
(transaction (manifest-transaction (install install)
(remove remove)))
(new (manifest-perform-transaction manifest transaction)))
(unless (and (null? install) (null? remove))
(show-manifest-transaction store manifest transaction
#:dry-run? dry-run?)
(build-and-use-profile store profile new
#:bootstrap? bootstrap?
#:use-substitutes? substitutes?
#:dry-run? dry-run?))))
;;;
;;; Entry point.
@ -798,39 +831,6 @@ (define (handle-argument arg result arg-handler)
(arg-handler arg result)
(leave (_ "~A: extraneous argument~%") arg)))
(define (process-actions opts)
;; Process any install/remove/upgrade action from OPTS.
(define dry-run? (assoc-ref opts 'dry-run?))
(define bootstrap? (assoc-ref opts 'bootstrap?))
(define substitutes? (assoc-ref opts 'substitutes?))
(define profile (or (assoc-ref opts 'profile) %current-profile))
;; First, process roll-backs, generation removals, etc.
(for-each (match-lambda
((key . arg)
(and=> (assoc-ref %actions key)
(lambda (proc)
(proc (%store) profile arg opts
#:dry-run? dry-run?)))))
opts)
;; Then, process normal package installation/removal/upgrade.
(let* ((manifest (profile-manifest profile))
(install (options->installable opts manifest))
(remove (options->removable opts manifest))
(transaction (manifest-transaction (install install)
(remove remove)))
(new (manifest-perform-transaction manifest transaction)))
(unless (and (null? install) (null? remove))
(show-manifest-transaction (%store) manifest transaction
#:dry-run? dry-run?)
(build-and-use-profile (%store) profile new
#:bootstrap? bootstrap?
#:use-substitutes? substitutes?
#:dry-run? dry-run?))))
(let ((opts (parse-command-line args %options (list %default-options #f)
#:argument-handler handle-argument)))
(with-error-handling
@ -844,4 +844,4 @@ (define profile (or (assoc-ref opts 'profile) %current-profile))
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(canonical-package guile-2.0)))))
(process-actions opts)))))))
(process-actions (%store) opts)))))))