bug#26339: [PATCH 07/18] system: Add bootloader type.

[Mathieu Othacehe <m.othacehe@gmail.com>]

* gnu/system/bootloader.scm
(<bootloader-configuration>)[type]: New field.
(%extlinux-configuration, %grub-configuration, %grub-efi-configuration,
%syslinux-configuration): New exported variables.
(extlinux-configuration, grub-configuration, grub-efi-configuration,
syslinux-configuration): New exported compatibility macros.
---
 gnu/system/bootloader.scm | 116 ++++++++++++++++++++++++++++++++--------------
 1 file changed, 82 insertions(+), 34 deletions(-)

diff --git a/gnu/system/bootloader.scm b/gnu/system/bootloader.scm
index ea570ee00..c2b23c380 100644
--- a/gnu/system/bootloader.scm
+++ b/gnu/system/bootloader.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 David Craven <david@craven.ch>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,10 +23,12 @@
   #:use-module (guix gexp)
   #:use-module (guix packages)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (bootloader-configuration
             bootloader-configuration?
             bootloader-configuration-bootloader
+            bootloader-configuration-type
             bootloader-configuration-device
             bootloader-configuration-menu-entries
             bootloader-configuration-default-entry
@@ -35,6 +38,13 @@
             bootloader-configuration-install-procedure
             bootloader-configuration-additional-configuration
 
+            %extlinux-configuration
+            %grub-configuration
+            %grub-efi-configuration
+            %syslinux-configuration
+
+            lookup-bootloader-configuration
+
             extlinux-configuration
             grub-configuration
             grub-efi-configuration
@@ -55,6 +65,8 @@
   bootloader-configuration?
   (bootloader                      bootloader-configuration-bootloader     ; package
                                    (default #f))
+  (type                            bootloader-configuration-type
+                                   (default #f))                           ; symbol
   (device                          bootloader-configuration-device         ; string
                                    (default #f))
   (menu-entries                    bootloader-configuration-menu-entries   ; list of <boot-parameters>
@@ -128,40 +140,6 @@ TIMEOUT ~a~%"
 \f
 
 ;;;
-;;; Bootloader configurations.
-;;;
-
-(define* (extlinux-configuration #:optional (config (bootloader-configuration)))
-  (bootloader-configuration
-   (inherit config)
-   (configuration-file-location "/boot/extlinux/extlinux.conf")
-   (configuration-file-procedure extlinux-configuration-file)))
-
-(define* (grub-configuration #:optional (config (bootloader-configuration)))
-  (bootloader-configuration
-   (inherit config)
-   (bootloader (@ (gnu packages bootloaders) grub))
-   (configuration-file-location "/boot/grub/grub.cfg")
-   (configuration-file-procedure grub-configuration-file)
-   (install-procedure install-grub)
-   (additional-configuration
-    (let ((additional-config (bootloader-configuration-additional-configuration config)))
-      (if additional-config additional-config %default-theme)))))
-
-(define* (grub-efi-configuration #:optional (config (bootloader-configuration)))
-  (bootloader-configuration
-   (inherit (grub-configuration config))
-   (bootloader (@ (gnu packages bootloaders) grub-efi))))
-
-(define* (syslinux-configuration #:optional (config (bootloader-configuration)))
-  (bootloader-configuration
-   (inherit (extlinux-configuration config))
-   (bootloader (@ (gnu packages bootloaders) syslinux))
-   (install-procedure install-syslinux)))
-
-\f
-
-;;;
 ;;; Bootloader install procedures.
 ;;;
 
@@ -202,4 +180,74 @@ TIMEOUT ~a~%"
                      (#$dd 440 1 (string-append syslinux-dir "/mbr.bin") device))
           (error "failed to install SYSLINUX")))))
 
+
+;;;
+;;; Bootloader configurations.
+;;;
+
+(define* %extlinux-configuration
+  (bootloader-configuration
+   (type 'extlinux)
+   (configuration-file-location "/boot/extlinux/extlinux.conf")
+   (configuration-file-procedure extlinux-configuration-file)))
+
+(define* %grub-configuration
+  (bootloader-configuration
+   (type 'grub)
+   (bootloader (@ (gnu packages bootloaders) grub))
+   (configuration-file-location "/boot/grub/grub.cfg")
+   (configuration-file-procedure grub-configuration-file)
+   (install-procedure install-grub)
+   (additional-configuration %default-theme)))
+
+(define* %grub-efi-configuration
+  (bootloader-configuration
+   (inherit %grub-configuration)
+   (type 'grub-efi)
+   (bootloader (@ (gnu packages bootloaders) grub-efi))))
+
+(define* %syslinux-configuration
+  (bootloader-configuration
+   (inherit %extlinux-configuration)
+   (type 'syslinux)
+   (bootloader (@ (gnu packages bootloaders) syslinux))
+   (install-procedure install-syslinux)))
+
+(define %bootloader-configurations
+  (list %extlinux-configuration
+        %grub-configuration
+        %grub-efi-configuration
+        %syslinux-configuration))
+
+(define (lookup-bootloader-configuration type)
+  (or (find (lambda (conf)
+              (eq? (bootloader-configuration-type conf)
+                   type))
+            %bootloader-configurations)
+      (error "~a: unknown bootloader type" type)))
+
+;;;
+;;; Compatibility macros.
+;;;
+
+(define-syntax-rule (extlinux-configuration fields ...)
+  (bootloader-configuration
+   (inherit %extlinux-configuration)
+   fields ...))
+
+(define-syntax-rule (grub-configuration fields ...)
+  (bootloader-configuration
+   (inherit %grub-configuration)
+   fields ...))
+
+(define-syntax-rule (grub-efi-configuration fields ...)
+  (bootloader-configuration
+   (inherit %grub-efi-configuration)
+   fields ...))
+
+(define-syntax-rule (syslinux-configuration fields ...)
+  (bootloader-configuration
+   (inherit %syslinux-configuration)
+   fields ...))
+
 ;;; bootloader.scm ends here
-- 
2.12.2