Subject: [PATCH v6 05/12] gnu: system: image: Reduce subprocedure indentation.

From: Herman Rimm <[email-masked]>
Date: Tue, 24 Sep 2024 20:29:12 +0200

* gnu/system/image.scm (system-disk-image): Reduce indentation.

Change-Id: I9cf59d3a61d0c6e7e90009e62661f74f774f090a
---
 gnu/system/image.scm | 115 ++++++++++++++++++++++---------------------
 1 file changed, 59 insertions(+), 56 deletions(-)

diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b58de1db14..6201b36334 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -448,63 +448,66 @@ (define* (system-disk-image image
                     (format #f (G_ "unsupported partition type: ~a")
                             file-system)))))))))
 
+    (define (image-builder partition)
+      "A directory, filled by calling the PARTITION initializer
+procedure, is first created within the store.  Then, an image of this
+directory is created using tools such as 'mke2fs' or 'mkdosfs',
+depending on the partition file-system type."
+      (let ((os (image-operating-system image))
+            (schema (local-file (search-path %load-path
+                                             "guix/store/schema.sql")))
+            (graph (match inputs
+                     (((names . _) ...)
+                      names)))
+            (type (partition-file-system partition)))
+        (with-imported-modules*
+          (let ((initializer (or #$(partition-initializer partition)
+                                 initialize-root-partition))
+                (inputs '#+(cond
+                             ((string-prefix? "ext" type)
+                              (list e2fsprogs fakeroot))
+                             ((or (string=? type "vfat")
+                                  (string-prefix? "fat" type))
+                              (list dosfstools fakeroot mtools))
+                             (else
+                               '())))
+                (image-root (string-append (getcwd) "/tmp-root"))
+                (copy-closures? (not #$(image-shared-store? image))))
+            (sql-schema #$schema)
+
+            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+
+            ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be
+            ;; decoded.
+            (setenv "GUIX_LOCPATH"
+                    #+(file-append (libc-utf8-locales-for-target
+                                    (%current-system))
+                                   "/lib/locale"))
+            (setlocale LC_ALL "en_US.utf8")
+
+            (initializer image-root
+                         #:references-graphs '#$graph
+                         #:deduplicate? #f
+                         #:copy-closures? copy-closures?
+                         #:system-directory #$os)
+            ;; There's no point installing a bootloader if we do not
+            ;; populate the store.
+            (when copy-closures?
+              ;; Root-offset isn't necessary: we override 'root.
+              #$(bootloader-configurations->gexp
+                  bootloader-config bootmeta
+                  #:overrides (targets partition)))
+            (make-partition-image #$(partition->gexp partition)
+                                  #$output
+                                  image-root)))))
+
     (define (partition-image partition)
-      ;; Return as a file-like object, an image of the given PARTITION.  A
-      ;; directory, filled by calling the PARTITION initializer procedure, is
-      ;; first created within the store.  Then, an image of this directory is
-      ;; created using tools such as 'mke2fs' or 'mkdosfs', depending on the
-      ;; partition file-system type.
-      (let* ((os (image-operating-system image))
-             (schema (local-file (search-path %load-path
-                                              "guix/store/schema.sql")))
-             (graph (match inputs
-                      (((names . _) ...)
-                       names)))
-             (type (partition-file-system partition))
-             (image-builder
-              (with-imported-modules*
-               (let ((initializer (or #$(partition-initializer partition)
-                                      initialize-root-partition))
-                     (inputs '#+(cond
-                                  ((string-prefix? "ext" type)
-                                   (list e2fsprogs fakeroot))
-                                  ((or (string=? type "vfat")
-                                       (string-prefix? "fat" type))
-                                   (list dosfstools fakeroot mtools))
-                                  (else
-                                    '())))
-                     (image-root (string-append (getcwd) "/tmp-root"))
-                     (copy-closures? (not #$(image-shared-store? image))))
-                 (sql-schema #$schema)
-
-                 (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-
-                 ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be
-                 ;; decoded.
-                 (setenv "GUIX_LOCPATH"
-                         #+(file-append (libc-utf8-locales-for-target
-                                         (%current-system))
-                                        "/lib/locale"))
-                 (setlocale LC_ALL "en_US.utf8")
-
-                 (initializer image-root
-                              #:references-graphs '#$graph
-                              #:deduplicate? #f
-                              #:copy-closures? copy-closures?
-                              #:system-directory #$os)
-                 ;; no point installing a bootloader if we don't populate store
-                 (when copy-closures?
-                   ;; root-offset isn't necessary - we override 'root
-                   #$(bootloader-configurations->gexp bootloader-config bootmeta
-                       #:overrides (targets partition)))
-                 (make-partition-image #$(partition->gexp partition)
-                                       #$output
-                                       image-root)))))
-        (computed-file "partition.img" image-builder
-                       ;; Allow offloading so that this I/O-intensive process
-                       ;; doesn't run on the build farm's head node.
-                       #:local-build? #f
-                       #:options `(#:references-graphs ,inputs))))
+      "Return as a file-like object, an image of the given PARTITION."
+      (computed-file "partition.img" (image-builder partition)
+                     ;; Allow offloading so that this I/O-intensive process
+                     ;; doesn't run on the build farm's head node.
+                     #:local-build? #f
+                     #:options `(#:references-graphs ,inputs)))
 
     (define (gpt-image? image)
       (eq? 'gpt (image-partition-table-type image)))
-- 
2.45.2