11/13: system: Account skeleton API is non-monadic.

[Ludovic Courtès]

civodul pushed a commit to branch wip-service-refactor
in repository guix.

commit 20f3665f2201dae9ffb9186f5a126cd3f23986a4
Author: Ludovic Courtès <address@hidden>
Date:   Sat Sep 19 12:12:29 2015 +0200

    system: Account skeleton API is non-monadic.
    
    * gnu/system/shadow.scm (default-skeletons): Use the non-monadic
      procedures and turn into a regular procedure.
      (skeleton-directory): Likewise.
    * gnu/system.scm (etc-directory): Adjust accordingly.
---
 gnu/system.scm        |    2 +-
 gnu/system/shadow.scm |   60 +++++++++++++++++++++++-------------------------
 2 files changed, 30 insertions(+), 32 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index cb0ee90..5eaafed 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -527,7 +527,7 @@ then
   # as those in ~/.guix-profile and /run/current-system/profile.
   source /run/current-system/profile/etc/profile.d/bash_completion.sh
 fi\n"))
-       (skel      (skeleton-directory skeletons)))
+       (skel ->   (skeleton-directory skeletons)))
     (file-union "etc"
                 `(("services" ,#~(string-append #$net-base "/etc/services"))
                   ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index f033109..ddd5f66 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -20,7 +20,6 @@
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
   #:use-module (guix sets)
   #:use-module (guix ui)
   #:use-module ((gnu system file-systems)
@@ -133,10 +132,10 @@
         (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
                    #$output)))
 
-  (mlet %store-monad ((profile (text-file "bash_profile" "\
+  (let ((profile (plain-file "bash_profile" "\
 # Honor per-interactive-shell startup file
 if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n"))
-                      (bashrc (text-file "bashrc" "\
+        (bashrc  (plain-file "bashrc" "\
 # Bash initialization for interactive non-login shells and
 # for remote shells (info \"(bash) Bash Startup Files\").
 
@@ -162,42 +161,41 @@ else
 fi
 alias ls='ls -p --color'
 alias ll='ls -l'\n"))
-                      (zlogin (text-file "zlogin" "\
+        (zlogin    (plain-file "zlogin" "\
 # Honor system-wide environment variables
 source /etc/profile\n"))
-                      (guile-wm (gexp->derivation "guile-wm" copy-guile-wm
-                                                  #:modules
-                                                  '((guix build utils))))
-                      (xdefaults (text-file "Xdefaults" "\
+        (guile-wm  (computed-file "guile-wm" copy-guile-wm
+                                  #:modules '((guix build utils))))
+        (xdefaults (plain-file "Xdefaults" "\
 XTerm*utf8: always
 XTerm*metaSendsEscape: true\n"))
-                      (gdbinit   (text-file "gdbinit" "\
+        (gdbinit   (plain-file "gdbinit" "\
 # Tell GDB where to look for separate debugging files.
 set debug-file-directory ~/.guix-profile/lib/debug\n")))
-    (return `((".bash_profile" ,profile)
-              (".bashrc" ,bashrc)
-              (".zlogin" ,zlogin)
-              (".Xdefaults" ,xdefaults)
-              (".guile-wm" ,guile-wm)
-              (".gdbinit" ,gdbinit)))))
+    `((".bash_profile" ,profile)
+      (".bashrc" ,bashrc)
+      (".zlogin" ,zlogin)
+      (".Xdefaults" ,xdefaults)
+      (".guile-wm" ,guile-wm)
+      (".gdbinit" ,gdbinit))))
 
 (define (skeleton-directory skeletons)
-  "Return a directory containing SKELETONS, a list of name/derivation pairs."
-  (gexp->derivation "skel"
-                    #~(begin
-                        (use-modules (ice-9 match))
-
-                        (mkdir #$output)
-                        (chdir #$output)
-
-                        ;; Note: copy the skeletons instead of symlinking
-                        ;; them like 'file-union' does, because 'useradd'
-                        ;; would just copy the symlinks as is.
-                        (for-each (match-lambda
-                                   ((target source)
-                                    (copy-file source target)))
-                                  '#$skeletons)
-                        #t)))
+  "Return a directory containing SKELETONS, a list of name/derivation tuples."
+  (computed-file "skel"
+                 #~(begin
+                     (use-modules (ice-9 match))
+
+                     (mkdir #$output)
+                     (chdir #$output)
+
+                     ;; Note: copy the skeletons instead of symlinking
+                     ;; them like 'file-union' does, because 'useradd'
+                     ;; would just copy the symlinks as is.
+                     (for-each (match-lambda
+                                 ((target source)
+                                  (copy-file source target)))
+                               '#$skeletons)
+                     #t)))
 
 (define (assert-valid-users/groups users groups)
   "Raise an error if USERS refer to groups not listed in GROUPS."