04/05: services: Make a single extensible 'file-systems' service.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit aa1145df8d43187f3e92aa505298cdeca4fb1191
Author: Ludovic Courtès <address@hidden>
Date:   Sun Aug 21 18:50:14 2016 +0200

    services: Make a single extensible 'file-systems' service.
    
    Previously we would create one 'file-system-service-type' instead per
    file system.  Now, we create only one instance for all the file
    systems.
    
    * gnu/services/base.scm (fstab-service-type)[compose]: Change to
    CONCATENATE.
    (file-system-shepherd-service): Change to return either one
    <shepherd-service> or #f.
    (file-system-service-type): Pluralize 'name'.  Adjust
    SHEPHERD-ROOT-SERVICE-TYPE extension to above changes.  Add 'compose'
    and 'extend'.
    (file-system-service): Remove.
    * gnu/system.scm (other-file-system-services): Rename to...
    (non-boot-file-system-service): ... this.  Change to return a single
    FILE-SYSTEM-SERVICE-TYPE instance.
    (essential-services): Adjust accordingly.
---
 gnu/services/base.scm |   34 +++++++++++++++-------------------
 gnu/system.scm        |   16 +++++++++-------
 2 files changed, 24 insertions(+), 26 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3b4c22f..f3f6408 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -49,7 +49,7 @@
   #:use-module (ice-9 format)
   #:export (fstab-service-type
             root-file-system-service
-            file-system-service
+            file-system-service-type
             user-unmount-service
             swap-service
             user-processes-service
@@ -164,7 +164,7 @@
                 (extensions
                  (list (service-extension etc-service-type
                                           file-systems->fstab)))
-                (compose identity)
+                (compose concatenate)
                 (extend append)))
 
 (define %root-file-system-shepherd-service
@@ -230,7 +230,8 @@ FILE-SYSTEM."
      (file-system->shepherd-service-name fs))))
 
 (define (file-system-shepherd-service file-system)
-  "Return a list containing the shepherd service for @var{file-system}."
+  "Return the shepherd service for @var{file-system}, or @code{#f} if
address@hidden is not auto-mounted upon boot."
   (let ((target  (file-system-mount-point file-system))
         (device  (file-system-device file-system))
         (type    (file-system-type file-system))
@@ -238,10 +239,9 @@ FILE-SYSTEM."
         (check?  (file-system-check? file-system))
         (create? (file-system-create-mount-point? file-system))
         (dependencies (file-system-dependencies file-system)))
-    (if (file-system-mount? file-system)
-        (with-imported-modules '((gnu build file-systems)
-                                 (guix build bournish))
-          (list
+    (and (file-system-mount? file-system)
+         (with-imported-modules '((gnu build file-systems)
+                                  (guix build bournish))
            (shepherd-service
             (provision (list (file-system->shepherd-service-name file-system)))
             (requirement `(root-file-system
@@ -290,23 +290,19 @@ FILE-SYSTEM."
             ;; We need an additional module.
             (modules `(((gnu build file-systems)
                         #:select (check-file-system canonicalize-device-spec))
-                       ,@%default-modules)))))
-        '())))
+                       ,@%default-modules)))))))
 
 (define file-system-service-type
-  ;; TODO(?): Make this an extensible service that takes <file-system> objects
-  ;; and returns a list of <shepherd-service>.
-  (service-type (name 'file-system)
+  (service-type (name 'file-systems)
                 (extensions
                  (list (service-extension shepherd-root-service-type
-                                          file-system-shepherd-service)
+                                          (lambda (file-systems)
+                                            (filter-map 
file-system-shepherd-service
+                                                        file-systems)))
                        (service-extension fstab-service-type
-                                          identity)))))
-
-(define* (file-system-service file-system)
-  "Return a service that mounts @var{file-system}, a @code{<file-system>}
-object."
-  (service file-system-service-type file-system))
+                                          identity)))
+                (compose concatenate)
+                (extend append)))
 
 (define user-unmount-service-type
   (shepherd-service-type
diff --git a/gnu/system.scm b/gnu/system.scm
index d6bf6c4..0802010 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -178,9 +178,9 @@
 ;;; Services.
 ;;;
 
-(define (other-file-system-services os)
-  "Return file system services for the file systems of OS that are not marked
-as 'needed-for-boot'."
+(define (non-boot-file-system-service os)
+  "Return the file system service for the file systems of OS that are not
+marked as 'needed-for-boot'."
   (define file-systems
     (remove file-system-needed-for-boot?
             (operating-system-file-systems os)))
@@ -204,7 +204,8 @@ as 'needed-for-boot'."
                                   (file-system-dependencies fs))
                           eq?))))
 
-  (map (compose file-system-service add-dependencies) file-systems))
+  (service file-system-service-type
+           (map add-dependencies file-systems)))
 
 (define (mapped-device-user device file-systems)
   "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
@@ -270,11 +271,11 @@ a container or that of a \"bare metal\" system."
 
   (let* ((mappings  (device-mapping-services os))
          (root-fs   (root-file-system-service))
-         (other-fs  (other-file-system-services os))
+         (other-fs  (non-boot-file-system-service os))
          (unmount   (user-unmount-service known-fs))
          (swaps     (swap-services os))
          (procs     (user-processes-service
-                     (map service-parameters other-fs)))
+                     (service-parameters other-fs)))
          (host-name (host-name-service (operating-system-host-name os)))
          (entries   (operating-system-directory-base-entries
                      os #:container? container?)))
@@ -302,7 +303,8 @@ a container or that of a \"bare metal\" system."
                     (operating-system-setuid-programs os))
            (service profile-service-type
                     (operating-system-packages os))
-           (append other-fs mappings swaps
+           other-fs
+           (append mappings swaps
 
                    ;; Add the firmware service, unless we are building for a
                    ;; container.