ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-15 11:25:22 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix system: De-monadify bootloader installation script.

Browse source 
* guix/scripts/system.scm (bootloader-installer-derivation): Rename
to...
(bootloader-installer-script): ... this.  Use 'scheme-file' instead of
'gexp->file'.
(perform-action): Adjust accordingly.  Move 'lower-object' call to the
point where DRVS is computed.
This commit is contained in:
Ludovic Courtès 2018-11-16 09:25:56 +01:00
parent 6e47628d4c
commit 52ee4479ef
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 34 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
guix/scripts/system.scm
View file

@ -175,12 +175,16 @@ (define progress-bar
(return *unspecified*)))
(define* (install-bootloader installer-drv
(define* (install-bootloader installer
#:key
bootcfg bootcfg-file
target)
"Call INSTALLER-DRV with error handling, in %STORE-MONAD."
(with-monad %store-monad
"Run INSTALLER, a bootloader installation script, with error handling, in
%STORE-MONAD."
(mlet %store-monad ((installer-drv (if installer
(lower-object installer)
(return #f)))
(bootcfg (lower-object bootcfg)))
(let* ((gc-root (string-append target %gc-roots-directory
"/bootcfg"))
(temp-gc-root (string-append gc-root ".new"))
@ -790,19 +794,18 @@ (define latest
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
(define (bootloader-installer-derivation installer
(define (bootloader-installer-script installer
bootloader device target)
"Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE
and TARGET arguments."
(with-monad %store-monad
(gexp->file "bootloader-installer"
(scheme-file "bootloader-installer"
(with-imported-modules '((gnu build bootloader)
(guix build utils))
#~(begin
(use-modules (gnu build bootloader)
(guix build utils)
(ice-9 binary-ports))
(#$installer #$bootloader #$device #$target))))))
(#$installer #$bootloader #$device #$target)))))
(define* (perform-action action os
#:key skip-safety-checks?
@ -851,31 +854,31 @@ (define println
#:mappings mappings))
(bootloader -> (bootloader-configuration-bootloader
(operating-system-bootloader os)))
(bootcfg (if (eq? 'container action)
(return #f)
(lower-object
(bootcfg -> (and (not (eq? 'container action))
(operating-system-bootcfg
os
(if (eq? 'init action)
'()
(map boot-parameters->menu-entry
(profile-boot-parameters)))))))
(profile-boot-parameters))))))
(bootcfg-file -> (bootloader-configuration-file bootloader))
(bootloader-installer
->
(let ((installer (bootloader-installer bootloader))
(target (or target "/")))
(bootloader-installer-derivation installer
(bootloader-installer-script installer
(bootloader-package bootloader)
bootloader-target target)))
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
(drvs -> (if (memq action '(init reconfigure))
(drvs (mapm %store-monad lower-object
(if (memq action '(init reconfigure))
(if install-bootloader?
(list sys bootcfg bootloader-installer)
(list sys bootcfg))
(list sys)))
(list sys))))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))