aboutsummaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-12-04 19:14:07 +0100
committerLudovic Courtès <ludo@gnu.org>2014-12-04 23:53:16 +0100
commitc3e79cde060a4dbbadd15235c6ea61aa8600cffe (patch)
tree605e356d05157bdf63a29630bf4963920d4101c1 /guix/scripts
parentbb986599e6967f0a990f78b57a886970981cf9f8 (diff)
downloadgnu-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.scm28
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'...~%")