guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

guix system: Extract action processing. 

* guix/scripts/system.scm (process-action): New procedure.  Extracted
  from...
  (guix-system): ... here.  Use it.
This commit is contained in:
Ludovic Courtès 2015-10-26 19:50:56 +01:00
parent e49de93aa5
commit deaab8e314
1 changed files with 51 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
guix/scripts/system.scm
View File

@ -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