nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix system: Clarify 'perform-action'. 

* guix/scripts/system.scm (perform-action): Move non-monadic local
variables outside the 'mlet' form.
This commit is contained in:
Ludovic Courtès 2018-11-16 10:12:10 +01:00
parent 52ee4479ef
commit ab6caf4f1d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
guix/scripts/system.scm
View File

@ -833,6 +833,25 @@ static checks."
(define println (define println
(cut format #t "~a~%" <>)) (cut format #t "~a~%" <>))
(define menu-entries
(if (eq? 'init action)
'()
(map boot-parameters->menu-entry (profile-boot-parameters))))
(define bootloader
(bootloader-configuration-bootloader (operating-system-bootloader os)))
(define bootcfg
(and (not (eq? 'container action))
(operating-system-bootcfg os menu-entries)))
(define bootloader-script
(let ((installer (bootloader-installer bootloader))
(target (or target "/")))
(bootloader-installer-script installer
(bootloader-package bootloader)
bootloader-target target)))
(when (eq? action 'reconfigure) (when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)) (maybe-suggest-running-guix-pull))
@ -852,23 +871,6 @@ static checks."
#:image-size image-size #:image-size image-size
#:full-boot? full-boot? #:full-boot? full-boot?
#:mappings mappings)) #:mappings mappings))
(bootloader -> (bootloader-configuration-bootloader
(operating-system-bootloader os)))
(bootcfg -> (and (not (eq? 'container action))
(operating-system-bootcfg
os
(if (eq? 'init action)
'()
(map boot-parameters->menu-entry
(profile-boot-parameters))))))
(bootcfg-file -> (bootloader-configuration-file bootloader))
(bootloader-installer
->
(let ((installer (bootloader-installer bootloader))
(target (or target "/")))
(bootloader-installer-script installer
(bootloader-package bootloader)
bootloader-target target)))
;; For 'init' and 'reconfigure', always build BOOTCFG, even if ;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root. ;; --no-bootloader is passed, because we then use it as a GC root.
@ -876,7 +878,7 @@ static checks."
(drvs (mapm %store-monad lower-object (drvs (mapm %store-monad lower-object
(if (memq action '(init reconfigure)) (if (memq action '(init reconfigure))
(if install-bootloader? (if install-bootloader?
(list sys bootcfg bootloader-installer) (list sys bootcfg bootloader-script)
(list sys bootcfg)) (list sys bootcfg))
(list sys)))) (list sys))))
(% (if derivations-only? (% (if derivations-only?
@ -887,7 +889,7 @@ static checks."
(if (or dry-run? derivations-only?) (if (or dry-run? derivations-only?)
(return #f) (return #f)
(begin (let ((bootcfg-file (bootloader-configuration-file bootloader)))
(for-each (compose println derivation->output-path) (for-each (compose println derivation->output-path)
drvs) drvs)
@ -896,7 +898,7 @@ static checks."
(mbegin %store-monad (mbegin %store-monad
(switch-to-system os) (switch-to-system os)
(mwhen install-bootloader? (mwhen install-bootloader?
(install-bootloader bootloader-installer (install-bootloader bootloader-script
#:bootcfg bootcfg #:bootcfg bootcfg
#:bootcfg-file bootcfg-file #:bootcfg-file bootcfg-file
#:target "/")))) #:target "/"))))