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.

1 files changed, 81 insertions, 64 deletions

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 12a57efdab..6cf0b02ac3 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)))