guix package: Move 'process-actions' out of sight.
* guix/scripts/package.scm (process-actions): New procedure, moved from... (guix-package): ... here. Adjust accordingly.
This commit is contained in:
parent
dfdb15d9c2
commit
6e37017506
@ -786,6 +786,39 @@ processed, #f otherwise."
|
|||||||
(delete-generations . ,delete-generations-action)
|
(delete-generations . ,delete-generations-action)
|
||||||
(manifest . ,manifest-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.
|
;;; Entry point.
|
||||||
@ -798,39 +831,6 @@ processed, #f otherwise."
|
|||||||
(arg-handler arg result)
|
(arg-handler arg result)
|
||||||
(leave (_ "~A: extraneous argument~%") arg)))
|
(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)
|
(let ((opts (parse-command-line args %options (list %default-options #f)
|
||||||
#:argument-handler handle-argument)))
|
#:argument-handler handle-argument)))
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
@ -844,4 +844,4 @@ processed, #f otherwise."
|
|||||||
(if (assoc-ref opts 'bootstrap?)
|
(if (assoc-ref opts 'bootstrap?)
|
||||||
%bootstrap-guile
|
%bootstrap-guile
|
||||||
(canonical-package guile-2.0)))))
|
(canonical-package guile-2.0)))))
|
||||||
(process-actions opts)))))))
|
(process-actions (%store) opts)))))))
|
||||||
|
Loading…
Reference in New Issue
Block a user