aboutsummaryrefslogtreecommitdiff
path: root/gnu/system.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system.scm')
-rw-r--r--gnu/system.scm104
1 files changed, 48 insertions, 56 deletions
diff --git a/gnu/system.scm b/gnu/system.scm
index cee5f37bcb..92a3ca3e6e 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -244,19 +244,18 @@ as 'needed-for-boot'."
(string->symbol (mapped-device-target md))))
(device-mappings fs))))
- (sequence %store-monad
- (map (lambda (fs)
- (match fs
- (($ <file-system> device title target type flags opts
- #f check? create?)
- (file-system-service device target type
- #:title title
- #:requirements (requirements fs)
- #:check? check?
- #:create-mount-point? create?
- #:options opts
- #:flags flags))))
- file-systems)))
+ (map (lambda (fs)
+ (match fs
+ (($ <file-system> device title target type flags opts
+ #f check? create?)
+ (file-system-service device target type
+ #:title title
+ #:requirements (requirements fs)
+ #:check? check?
+ #:create-mount-point? create?
+ #:options opts
+ #:flags flags))))
+ file-systems))
(define (mapped-device-user device file-systems)
"Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
@@ -287,23 +286,21 @@ from the initrd."
devices)))
(define (device-mapping-services os)
- "Return the list of device-mapping services for OS as a monadic list."
- (sequence %store-monad
- (map (lambda (md)
- (let* ((source (mapped-device-source md))
- (target (mapped-device-target md))
- (type (mapped-device-type md))
- (open (mapped-device-kind-open type))
- (close (mapped-device-kind-close type)))
- (device-mapping-service target
- (open source target)
- (close source target))))
- (operating-system-user-mapped-devices os))))
+ "Return the list of device-mapping services for OS as a list."
+ (map (lambda (md)
+ (let* ((source (mapped-device-source md))
+ (target (mapped-device-target md))
+ (type (mapped-device-type md))
+ (open (mapped-device-kind-open type))
+ (close (mapped-device-kind-close type)))
+ (device-mapping-service target
+ (open source target)
+ (close source target))))
+ (operating-system-user-mapped-devices os)))
(define (swap-services os)
- "Return the list of swap services for OS as a monadic list."
- (sequence %store-monad
- (map swap-service (operating-system-swap-devices os))))
+ "Return the list of swap services for OS."
+ (map swap-service (operating-system-swap-devices os)))
(define (essential-services os)
"Return the list of essential services for OS. These are special services
@@ -312,26 +309,23 @@ bookkeeping."
(define known-fs
(map file-system-mount-point (operating-system-file-systems os)))
- (mlet* %store-monad ((mappings (device-mapping-services os))
- (root-fs (root-file-system-service))
- (other-fs (other-file-system-services os))
- (unmount (user-unmount-service known-fs))
- (swaps (swap-services os))
- (procs (user-processes-service
- (map (compose first service-provision)
- other-fs)))
- (host-name (host-name-service
- (operating-system-host-name os))))
- (return (cons* host-name procs root-fs unmount
- (append other-fs mappings swaps)))))
+ (let* ((mappings (device-mapping-services os))
+ (root-fs (root-file-system-service))
+ (other-fs (other-file-system-services os))
+ (unmount (user-unmount-service known-fs))
+ (swaps (swap-services os))
+ (procs (user-processes-service
+ (map (compose first service-provision)
+ other-fs)))
+ (host-name (host-name-service (operating-system-host-name os))))
+ (cons* host-name procs root-fs unmount
+ (append other-fs mappings swaps))))
(define (operating-system-services os)
"Return all the services of OS, including \"internal\" services that do not
explicitly appear in OS."
- (mlet %store-monad
- ((user (sequence %store-monad (operating-system-user-services os)))
- (essential (essential-services os)))
- (return (append essential user))))
+ (append (operating-system-user-services os)
+ (essential-services os)))
;;;
@@ -420,8 +414,7 @@ settings for 'guix.el' to work out-of-the-box."
(define (user-shells os)
"Return the list of all the shells used by the accounts of OS. These may be
gexps or strings."
- (mlet %store-monad ((accounts (operating-system-accounts os)))
- (return (map user-account-shell accounts))))
+ (map user-account-shell (operating-system-accounts os)))
(define (shells-file shells)
"Return a derivation that builds a shell list for use as /etc/shells based
@@ -577,9 +570,9 @@ fi\n"))
(operating-system-users os)
(cons %root-account (operating-system-users os))))
- (mlet %store-monad ((services (operating-system-services os)))
- (return (append users
- (append-map service-user-accounts services)))))
+ (append users
+ (append-map service-user-accounts
+ (operating-system-services os))))
(define (maybe-string->file file-name thing)
"If THING is a string, return a <plain-file> with THING as its content.
@@ -615,7 +608,7 @@ use 'plain-file' instead~%")
(define (operating-system-etc-directory os)
"Return that static part of the /etc directory of OS."
(mlet* %store-monad
- ((services (operating-system-services os))
+ ((services -> (operating-system-services os))
(pam-services ->
;; Services known to PAM.
(append (operating-system-pam-services os)
@@ -626,7 +619,7 @@ use 'plain-file' instead~%")
"hosts"
(or (operating-system-hosts-file os)
(default-/etc/hosts (operating-system-host-name os)))))
- (shells (user-shells os)))
+ (shells -> (user-shells os)))
(etc-directory #:pam-services pam-services
#:skeletons skeletons
#:issue (operating-system-issue os)
@@ -713,7 +706,7 @@ etc."
(sequence %store-monad (map (cut gexp->file "activate-service.scm" <>)
gexps))))
- (mlet* %store-monad ((services (operating-system-services os))
+ (mlet* %store-monad ((services -> (operating-system-services os))
(actions (service-activations services))
(etc (operating-system-etc-directory os))
(modules (imported-modules %modules))
@@ -721,7 +714,7 @@ etc."
(modprobe (modprobe-wrapper))
(firmware (directory-union
"firmware" (operating-system-firmware os)))
- (accounts (operating-system-accounts os)))
+ (accounts -> (operating-system-accounts os)))
(define setuid-progs
(operating-system-setuid-programs os))
@@ -789,9 +782,8 @@ etc."
"Return the boot script for OS---i.e., the code started by the initrd once
we're running in the final root. When CONTAINER? is true, skip all
hardware-related operations as necessary when booting a Linux container."
- (mlet* %store-monad ((services (operating-system-services os))
- (activate (operating-system-activation-script
- os #:container? container?))
+ (mlet* %store-monad ((services -> (operating-system-services os))
+ (activate (operating-system-activation-script os))
(dmd-conf (dmd-configuration-file services)))
(gexp->file "boot"
#~(begin