rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2014-12-04 19:14:07 +01:00
parent bb986599e6
commit c3e79cde06
1 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
guix/scripts/system.scm
View File

@ -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'...~%")