[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/09: guix package: Formalize the list of actions.
From: |
Ludovic Courtès |
Subject: |
05/09: guix package: Formalize the list of actions. |
Date: |
Mon, 30 Nov 2015 22:20:48 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit 590558953b4fb514b8157a48a89bae3af3121fa0
Author: Ludovic Courtès <address@hidden>
Date: Mon Nov 30 13:46:31 2015 +0100
guix package: Formalize the list of actions.
* guix/scripts/package.scm (roll-back-action, switch-generation-action)
(delete-generations-action, manifest-action): New procedures.
(%actions): New variable.
* guix/scripts/package.scm (guix-package)[process-action]: Rewrite to
traverse %ACTIONS.
---
guix/scripts/package.scm | 145 ++++++++++++++++++++++++++--------------------
1 files changed, 81 insertions(+), 64 deletions(-)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 12a57ef..6cf0b02 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -624,6 +624,11 @@ doesn't need it."
(add-indirect-root store absolute))
+
+;;;
+;;; Queries and actions.
+;;;
+
(define (process-query opts)
"Process any query specified by OPTS. Return #t when a query was actually
processed, #f otherwise."
@@ -729,6 +734,58 @@ processed, #f otherwise."
(_ #f))))
+
+(define* (roll-back-action store profile arg opts
+ #:key dry-run?)
+ "Roll back PROFILE to its previous generation."
+ (unless dry-run?
+ (roll-back* store profile)))
+
+(define* (switch-generation-action store profile spec opts
+ #:key dry-run?)
+ "Switch PROFILE to the generation specified by SPEC."
+ (unless dry-run?
+ (let* ((number (string->number spec))
+ (number (and number
+ (case (string-ref spec 0)
+ ((#\+ #\-)
+ (relative-generation profile number))
+ (else number)))))
+ (if number
+ (switch-to-generation* profile number)
+ (leave (_ "cannot switch to generation '~a'~%") spec)))))
+
+(define* (delete-generations-action store profile pattern opts
+ #:key dry-run?)
+ "Delete PROFILE's generations that match PATTERN."
+ (unless dry-run?
+ (delete-matching-generations store profile pattern)))
+
+(define* (manifest-action store profile file opts
+ #:key dry-run?)
+ "Change PROFILE to contain the packages specified in FILE."
+ (let* ((user-module (make-user-module '((guix profiles) (gnu))))
+ (manifest (load* file user-module))
+ (bootstrap? (assoc-ref opts 'bootstrap?))
+ (substitutes? (assoc-ref opts 'substitutes?)))
+ (if dry-run?
+ (format #t (_ "would install new manifest from '~a' with ~d entries~%")
+ file (length (manifest-entries manifest)))
+ (format #t (_ "installing new manifest from '~a' with ~d entries~%")
+ file (length (manifest-entries manifest))))
+ (build-and-use-profile store profile manifest
+ #:bootstrap? bootstrap?
+ #:use-substitutes? substitutes?
+ #:dry-run? dry-run?)))
+
+(define %actions
+ ;; List of actions that may be processed. The car of each pair is the
+ ;; action's symbol in the option list; the cdr is the action's procedure.
+ `((roll-back? . ,roll-back-action)
+ (switch-generation . ,switch-generation-action)
+ (delete-generations . ,delete-generations-action)
+ (manifest . ,manifest-action)))
+
;;;
;;; Entry point.
@@ -749,70 +806,30 @@ processed, #f otherwise."
(define substitutes? (assoc-ref opts 'substitutes?))
(define profile (or (assoc-ref opts 'profile) %current-profile))
- ;; First roll back if asked to.
- (cond ((and (assoc-ref opts 'roll-back?)
- (not dry-run?))
- (roll-back* (%store) profile)
- (process-actions (alist-delete 'roll-back? opts)))
- ((and (assoc-ref opts 'switch-generation)
- (not dry-run?))
- (for-each
- (match-lambda
- (('switch-generation . pattern)
- (let* ((number (string->number pattern))
- (number (and number
- (case (string-ref pattern 0)
- ((#\+ #\-)
- (relative-generation profile number))
- (else number)))))
- (if number
- (switch-to-generation* profile number)
- (leave (_ "cannot switch to generation '~a'~%")
- pattern)))
- (process-actions (alist-delete 'switch-generation opts)))
- (_ #f))
- opts))
- ((and (assoc-ref opts 'delete-generations)
- (not dry-run?))
- (for-each
- (match-lambda
- (('delete-generations . pattern)
- (delete-matching-generations (%store) profile pattern)
-
- (process-actions
- (alist-delete 'delete-generations opts)))
- (_ #f))
- opts))
- ((assoc-ref opts 'manifest)
- (let* ((file-name (assoc-ref opts 'manifest))
- (user-module (make-user-module '((guix profiles)
- (gnu))))
- (manifest (load* file-name user-module)))
- (if dry-run?
- (format #t (_ "would install new manifest from '~a' with ~d
entries~%")
- file-name (length (manifest-entries manifest)))
- (format #t (_ "installing new manifest from '~a' with ~d
entries~%")
- file-name (length (manifest-entries manifest))))
- (build-and-use-profile (%store) profile manifest
- #:bootstrap? bootstrap?
- #:use-substitutes? substitutes?
- #:dry-run? dry-run?)))
- (else
- (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?))))))
+ ;; 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)))
- branch master updated (ccd20fc -> 64ec0e2), Ludovic Courtès, 2015/11/30
- 01/09: guix package: Remove unnecessary use of (%store)., Ludovic Courtès, 2015/11/30
- 07/09: guix package: Move 'process-actions' out of sight., Ludovic Courtès, 2015/11/30
- 03/09: guix package: Move 'build-and-use-profile' out of sight., Ludovic Courtès, 2015/11/30
- 06/09: build: Fix detection of ARM systems., Ludovic Courtès, 2015/11/30
- 02/09: guix package: Move a couple of procedures out of sight., Ludovic Courtès, 2015/11/30
- 05/09: guix package: Formalize the list of actions.,
Ludovic Courtès <=
- 08/09: guix package: Refactor 'options->installable'., Ludovic Courtès, 2015/11/30
- 09/09: guix build: Modularize transformation handling., Ludovic Courtès, 2015/11/30
- 04/09: nls: Update 'de' translation., Ludovic Courtès, 2015/11/30