[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/13: guix system: Extract action processing.
From: |
Ludovic Courtès |
Subject: |
05/13: guix system: Extract action processing. |
Date: |
Mon, 26 Oct 2015 23:02:26 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit deaab8e314982d1ddb65e41d043ceb5de3c3b723
Author: Ludovic Courtès <address@hidden>
Date: Mon Oct 26 19:50:56 2015 +0100
guix system: Extract action processing.
* guix/scripts/system.scm (process-action): New procedure. Extracted
from...
(guix-system): ... here. Use it.
---
guix/scripts/system.scm | 95 +++++++++++++++++++++++++----------------------
1 files changed, 51 insertions(+), 44 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 8775267..d973e60 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -550,6 +550,55 @@ Build the operating system declared in FILE according to
ACTION.\n"))
;;; Entry point.
;;;
+(define (process-action action args opts)
+ "Process ACTION, a sub-command, whose arguments are listed in ARGS. OPTS is
+the raw alist of options resulting from command-line parsing."
+ (let* ((file (match args
+ (() #f)
+ ((x . _) x)))
+ (system (assoc-ref opts 'system))
+ (os (if file
+ (load* file %user-module
+ #:on-error (assoc-ref opts 'on-error))
+ (leave (_ "no configuration file specified~%"))))
+
+ (dry? (assoc-ref opts 'dry-run?))
+ (grub? (assoc-ref opts 'install-grub?))
+ (target (match args
+ ((first second) second)
+ (_ #f)))
+ (device (and grub?
+ (grub-configuration-device
+ (operating-system-bootloader os)))))
+
+ (with-store store
+ (set-build-options-from-command-line store opts)
+
+ (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (case action
+ ((extension-graph)
+ (export-extension-graph os (current-output-port)))
+ ((dmd-graph)
+ (export-dmd-graph os (current-output-port)))
+ (else
+ (perform-action action os
+ #:dry-run? dry?
+ #:derivations-only? (assoc-ref opts
+ 'derivations-only?)
+ #:use-substitutes? (assoc-ref opts 'substitutes?)
+ #:image-size (assoc-ref opts 'image-size)
+ #:full-boot? (assoc-ref opts 'full-boot?)
+ #:mappings (filter-map (match-lambda
+ (('file-system-mapping .
m)
+ m)
+ (_ #f))
+ opts)
+ #:grub? grub?
+ #:target target #:device device))))
+ #:system system))))
+
(define (guix-system . args)
(define (parse-sub-command arg result)
;; Parse sub-command ARG and augment RESULT accordingly.
@@ -600,49 +649,7 @@ Build the operating system declared in FILE according to
ACTION.\n"))
#:argument-handler
parse-sub-command))
(args (option-arguments opts))
- (file (first args))
- (action (assoc-ref opts 'action))
- (system (assoc-ref opts 'system))
- (os (if file
- (load* file %user-module
- #:on-error (assoc-ref opts 'on-error))
- (leave (_ "no configuration file specified~%"))))
-
- (dry? (assoc-ref opts 'dry-run?))
- (grub? (assoc-ref opts 'install-grub?))
- (target (match args
- ((first second) second)
- (_ #f)))
- (device (and grub?
- (grub-configuration-device
- (operating-system-bootloader os))))
-
- (store (open-connection)))
- (set-build-options-from-command-line store opts)
-
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (case action
- ((extension-graph)
- (export-extension-graph os (current-output-port)))
- ((dmd-graph)
- (export-dmd-graph os (current-output-port)))
- (else
- (perform-action action os
- #:dry-run? dry?
- #:derivations-only? (assoc-ref opts
- 'derivations-only?)
- #:use-substitutes? (assoc-ref opts 'substitutes?)
- #:image-size (assoc-ref opts 'image-size)
- #:full-boot? (assoc-ref opts 'full-boot?)
- #:mappings (filter-map (match-lambda
- (('file-system-mapping .
m)
- m)
- (_ #f))
- opts)
- #:grub? grub?
- #:target target #:device device))))
- #:system system))))
+ (command (assoc-ref opts 'action)))
+ (process-action command args opts))))
;;; system.scm ends here
- branch master updated (64a7192 -> 7e9b07b), Ludovic Courtès, 2015/10/26
- 02/13: gnu: Add python-file., Ludovic Courtès, 2015/10/26
- 01/13: gnu: Add RPM., Ludovic Courtès, 2015/10/26
- 03/13: doc: Add a REPL example., Ludovic Courtès, 2015/10/26
- 06/13: utils: Add 'readlink*'., Ludovic Courtès, 2015/10/26
- 05/13: guix system: Extract action processing.,
Ludovic Courtès <=
- 04/13: ui: Add 'matching-generations'., Ludovic Courtès, 2015/10/26
- 07/13: ui: Add procedures to display a profile generation., Ludovic Courtès, 2015/10/26
- 08/13: guix system: Factorize boot parameter parsing., Ludovic Courtès, 2015/10/26
- 10/13: utils: Add 'switch-symlinks', moved from (guix ui)., Ludovic Courtès, 2015/10/26
- 09/13: guix system: Add the 'list-generations' command., Ludovic Courtès, 2015/10/26
- 11/13: profiles: Add generation manipulation procedures., Ludovic Courtès, 2015/10/26
- 12/13: gnu: Add xcompmgr., Ludovic Courtès, 2015/10/26
- 13/13: gnu: Add yapet., Ludovic Courtès, 2015/10/26