diff options
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | 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 8775267f80..d973e60730 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 |