05/06: system: File systems depend on their corresponding device mappings.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit e502bf8953afcd1e0cf29cd729e7c62c5c27792f
Author: Ludovic Courtès <address@hidden>
Date:   Thu Oct 29 18:22:19 2015 +0100

    system: File systems depend on their corresponding device mappings.
    
    Fixes a regression introduced in commit 0adfe95.
    
    * gnu/system.scm (other-file-system-services)[requirements]: Remove.
      [add-dependencies]: New procedure.
      Use it.
    * gnu/system/file-systems.scm (<file-system>)[dependencies]: Update
      comment.
    * gnu/services/base.scm (mapped-device->dmd-service-name,
      dependency->dmd-service-name): New procedures.
      (file-system-service-type): Use it.
---
 gnu/services/base.scm       |   14 +++++++++++++-
 gnu/system.scm              |   23 ++++++++++-------------
 gnu/system/file-systems.scm |    5 ++---
 3 files changed, 25 insertions(+), 17 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index b8e8ccd..604416b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -144,6 +144,18 @@ FILE-SYSTEM."
   (symbol-append 'file-system-
                  (string->symbol (file-system-mount-point file-system))))
 
+(define (mapped-device->dmd-service-name md)
+  "Return the symbol that denotes the dmd service of MD, a <mapped-device>."
+  (symbol-append 'device-mapping-
+                 (string->symbol (mapped-device-target md))))
+
+(define dependency->dmd-service-name
+  (match-lambda
+    ((? mapped-device? md)
+     (mapped-device->dmd-service-name md))
+    ((? file-system? fs)
+     (file-system->dmd-service-name fs))))
+
 (define file-system-service-type
   ;; TODO(?): Make this an extensible service that takes <file-system> objects
   ;; and returns a list of <dmd-service>.
@@ -160,7 +172,7 @@ FILE-SYSTEM."
        (dmd-service
         (provision (list (file-system->dmd-service-name file-system)))
         (requirement `(root-file-system
-                       ,@(map file-system->dmd-service-name dependencies)))
+                       ,@(map dependency->dmd-service-name dependencies)))
         (documentation "Check, mount, and unmount the given file system.")
         (start #~(lambda args
                    ;; FIXME: Use or factorize with 'mount-file-system'.
diff --git a/gnu/system.scm b/gnu/system.scm
index aa76882..37d6d07 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -195,19 +195,16 @@ as 'needed-for-boot'."
                         (file-system-device fs)))
             (operating-system-mapped-devices os)))
 
-  (define (requirements fs)
-    ;; XXX: Fiddling with dmd service names is not nice.
-    (append (map (lambda (fs)
-                   (symbol-append 'file-system-
-                                  (string->symbol
-                                   (file-system-mount-point fs))))
-                 (file-system-dependencies fs))
-            (map (lambda (md)
-                   (symbol-append 'device-mapping-
-                                  (string->symbol (mapped-device-target md))))
-                 (device-mappings fs))))
-
-  (map file-system-service file-systems))
+  (define (add-dependencies fs)
+    ;; Add the dependencies due to device mappings to FS.
+    (file-system
+      (inherit fs)
+      (dependencies
+       (delete-duplicates (append (device-mappings fs)
+                                  (file-system-dependencies fs))
+                          eq?))))
+
+  (map (compose file-system-service add-dependencies) file-systems))
 
 (define (mapped-device-user device file-systems)
   "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 8155b27..0a4b385 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -99,9 +99,8 @@
                     (default #t))
   (create-mount-point? file-system-create-mount-point? ; Boolean
                        (default #f))
-  (dependencies     file-system-dependencies      ; list of strings (mount
-                                                  ; points depended on)
-                    (default '())))
+  (dependencies     file-system-dependencies      ; list of <file-system>
+                    (default '())))               ; or <mapped-device>
 
 (define-inlinable (file-system-needed-for-boot? fs)
   "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root