From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:37317) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gNaZj-0007Gb-U6 for guix-patches@gnu.org; Fri, 16 Nov 2018 04:38:09 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gNaZi-0003ES-Pv for guix-patches@gnu.org; Fri, 16 Nov 2018 04:38:07 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:50515) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gNaZi-0003EL-MC for guix-patches@gnu.org; Fri, 16 Nov 2018 04:38:06 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1gNaZh-00016u-3T for guix-patches@gnu.org; Fri, 16 Nov 2018 04:38:06 -0500 Subject: [bug#33405] [PATCH 09/10] guix system: De-monadify bootloader installation script. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Fri, 16 Nov 2018 10:36:23 +0100 Message-Id: <20181116093624.4820-9-ludo@gnu.org> In-Reply-To: <20181116093624.4820-1-ludo@gnu.org> References: <20181116093624.4820-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 33405@debbugs.gnu.org * 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. --- guix/scripts/system.scm | 65 +++++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 31 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 14488107b8..6f00f12509 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -175,12 +175,16 @@ TARGET, and register them." (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 @@ checking this by themselves in their 'check' procedure." (warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%")) (warning (G_ "Failing to do that may downgrade your system!~%")))) -(define (bootloader-installer-derivation installer - bootloader device target) +(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" - (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)))))) + (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))))) (define* (perform-action action os #:key skip-safety-checks? @@ -851,31 +854,31 @@ static checks." #:mappings mappings)) (bootloader -> (bootloader-configuration-bootloader (operating-system-bootloader os))) - (bootcfg (if (eq? 'container action) - (return #f) - (lower-object - (operating-system-bootcfg - os - (if (eq? 'init action) - '() - (map boot-parameters->menu-entry - (profile-boot-parameters))))))) + (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-derivation installer - (bootloader-package bootloader) - bootloader-target target))) + (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 . - (drvs -> (if (memq action '(init reconfigure)) - (if install-bootloader? - (list sys bootcfg bootloader-installer) - (list sys bootcfg)) - (list sys))) + (drvs (mapm %store-monad lower-object + (if (memq action '(init reconfigure)) + (if install-bootloader? + (list sys bootcfg bootloader-installer) + (list sys bootcfg)) + (list sys)))) (% (if derivations-only? (return (for-each (compose println derivation-file-name) drvs)) -- 2.19.1