From affda634d5d68eb8a217815faad4ab61432d1c0e Mon Sep 17 00:00:00 2001
From: Herman Rimm <herman@rimm.ee>
Date: Tue, 1 Oct 2024 13:57:57 +0200
Subject: [PATCH] gnu: bootloader: Use define-configuration.

* gnu/bootloader.scm (bootloader-target): Use define-configuration.

Change-Id: I9c98da238bcb00639137349b2312a34336928aac
---
 gnu/bootloader.scm | 59 +++++++++++++++++++++++++++++++---------------
 1 file changed, 40 insertions(+), 19 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index c236eea367..2ab2496412 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -29,6 +29,7 @@ (define-module (gnu bootloader)
   #:autoload   (gnu build file-systems)
                (read-partition-label read-partition-uuid
                 find-partition-by-label find-partition-by-uuid)
+  #:use-module (gnu services configuration)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
   #:autoload   (guix build syscalls)
@@ -305,20 +306,38 @@ (define-record-type* <bootloader>
 ;; <bootloader-target> represents different kinds of targets in a
 ;; normalized form.
 
-(define-record-type* <bootloader-target>
-  bootloader-target make-bootloader-target bootloader-target?
-  (type bootloader-target-type)                            ; symbol
-  (expected? bootloader-target-expected? (default #f))     ; bool
+(define (string-or-boolean? x)
+  (or (string? x) (boolean? x)))
 
-  (path bootloader-target-path (default #f))               ; string|#f
-  (offset bootloader-target-offset (thunked)               ; symbol|#f
-          (default (and (bootloader-target-path this-record)
-                        (not (eq? (bootloader-target-type this-record) 'root))
-                        'root)))
-  (device bootloader-target-device (default #f))           ; string|#f
-  (file-system bootloader-target-file-system (default #f)) ; string|#f
-  (label bootloader-target-label (default #f))             ; string|#f
-  (uuid bootloader-target-uuid (default #f)))              ; uuid|#f
+(define (symbol-or-boolean? x)
+  (or (symbol? x) (boolean? x)))
+
+;; XXX: Are file-system-labels all that good?
+;; Could a block-device record be better, instead?
+(define (file-system-label-or-boolean? x)
+  (or (file-system-label? x) (boolean? x)))
+
+(define (uuid-or-boolean? x)
+  (or (uuid? x) (boolean? x)))
+
+(define-configuration/no-serialization bootloader-target
+  (type symbol "What target this record describes, e.g. 'esp or 'disk.")
+  (expected? (boolean #f) "TODO")
+  (path (string-or-boolean #f) "TODO")
+  (offset (symbol-or-boolean #f) "TODO")
+  (device
+   (string-or-boolean #f)
+   "Refers to a physical device or partition.  A string is interpreted
+as a block device.  Note that block devices can vary per boot and may
+not exist at boot-time.  The find-partition-uuid procedure returns a
+block device's UUID.")
+  (file-system
+   (string-or-boolean #f)
+   "Set the type of the file system, in case it isn't being detected
+properly, or it is unmounted during bootloader installation.  See also
+the find-file-system and uuid->file-system procedures.")
+  (label (string-or-boolean #f) "TODO")
+  (uuid (uuid-or-boolean #f) "TODO"))
 
 (define-condition-type &target-error &error target-error?
   (type target-error-type)
@@ -365,8 +384,8 @@ (define (pathcat p1 p2)
   (string-append (string-trim-right p1 #\/) "/" (string-trim p2 #\/)))
 
 (define* (get-target-of-type type targets #:optional require?)
-  "Finds a target in TARGETS of type TYPE, returns REQUIRE? if #false,
-or provides an error otherwise."
+  "Finds a target in TARGETS of type TYPE, returns #f if REQUIRE? is #f,
+and provides an error otherwise."
   (define (type? target)
     (eq? type (bootloader-target-type target)))
   (match (filter type? targets)
@@ -406,13 +425,14 @@ (define* (ensure-target-types types targets #:optional (base? #f))
   "Ensures all TYPES are provided in TARGETS.  Returns #t iff every ensured
 target and its requirements are fully provided.  Errors out when a required TYPE
 isn't provided.  When BASE?, only ensure path requirements up to a device."
-  (not (any bootloader-target-expected?
-         (ensure types targets (if base? target-base? not)))))
+  (let ((base (if base? target-base? not)))
+    (not (any bootloader-target-expected? (ensure types targets base)))))
 
 (define (ensure-majors types targets)
   "Errors out when a required TYPE isn't provided, or when use of multiple major
 targets is detected."
-  (let* ((all (map bootloader-target-type (ensure types targets target-base?)))
+  (let* ((all (map bootloader-target-type
+                   (ensure types targets target-base?)))
          (majors (delete-duplicates (filter type-major? all) eq?)))
     (if (< (length majors) 2) #t
       (raise (condition (&message (message (G_ "multiple major targets used")))
@@ -473,7 +493,8 @@ (define blocks
            ((spec ... expr)
             (let* ((path? (cut syntax-case <> (:path) ((_ :path) #t) (_ #f)))
                    (qualified? (cut syntax-case <> (=>)
-                                 ((_ => spec ...) (any path? #'(spec ...)))
+                                 ((_ => spec ...)
+                                  (any path? #'(spec ...)))
                                  (_ #f)))
                    (specs #'(spec ...))
                    (lets (apply append (filter-map binds specs)))