diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-12-04 19:14:07 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-12-04 23:53:16 +0100 |
| commit | c3e79cde060a4dbbadd15235c6ea61aa8600cffe (patch) | |
| tree | 605e356d05157bdf63a29630bf4963920d4101c1 /guix/scripts | |
| parent | bb986599e6967f0a990f78b57a886970981cf9f8 (diff) | |
| download | gnu-guix-c3e79cde060a4dbbadd15235c6ea61aa8600cffe.tar gnu-guix-c3e79cde060a4dbbadd15235c6ea61aa8600cffe.tar.gz | |
guix system: Factorize 'grub-install' error handling, and use more 'mbegin'.
* guix/scripts/system.scm (install-grub*): New procedure.
(install): Use it, and use 'mwhen?'.
(perform-action) <reconfigure>: Likewise.
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/system.scm | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 8e049a4f45..35f858cf29 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -131,6 +131,14 @@ TARGET, and register them." (map (cut copy-item <> target #:log-port log-port) to-copy)))) +(define (install-grub* grub.cfg device target) + "This is a variant of 'install-grub' with error handling, lifted in +%STORE-MONAD" + (with-monad %store-monad + (unless (false-if-exception (install-grub grub.cfg device target)) + (leave (_ "failed to install GRUB on device '~a'~%") device)) + (return #t))) + (define* (install os-drv target #:key (log-port (current-output-port)) grub? grub.cfg device) @@ -162,11 +170,8 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG." (format log-port "populating '~a'...~%" target) (populate os-dir target) - (begin - (when grub? - (unless (false-if-exception (install-grub grub.cfg device target)) - (leave (_ "failed to install GRUB on device '~a'~%") device))) - (return #t))))) + (mwhen grub? + (install-grub* grub.cfg device target))))) ;;; @@ -338,14 +343,11 @@ boot directly to the kernel or to the bootloader." (case action ((reconfigure) - (mlet %store-monad ((% (switch-to-system os))) - (when grub? - (unless (false-if-exception - (install-grub (derivation->output-path grub.cfg) - device "/")) - (leave (_ "failed to install GRUB on device '~a'~%") - device))) - (return #t))) + (mbegin %store-monad + (switch-to-system os) + (mwhen grub? + (install-grub* (derivation->output-path grub.cfg) + device "/")))) ((init) (newline) (format #t (_ "initializing operating system under '~a'...~%") |