summaryrefslogtreecommitdiff
path: root/gnu/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-09 09:17:31 +0200
committerLudovic Courtès <ludo@gnu.org>2015-10-10 22:46:14 +0200
commitbe1c2c54d9f918f50f71c6d32a72d4498c07504c (patch)
tree642d087516b3ae7c2ffad6444e25b410712c92be /gnu/system.scm
parentce8a6dfc43265787c23fb93d3877fbcacb0451e4 (diff)
system: Make service procedures non-monadic.
* gnu/services/avahi.scm (configuration-file): Use 'plain-file' instead of 'text-file'. (avahi-service): Turn into a regular procedure that returns a <service>. * gnu/services/base.scm (root-file-system-service, file-system-service, user-unmount-service, user-processes-service, host-name-service, console-keymap-service, console-font-service, mingetty-service, nscd.conf-file, nscd-service): Likewise. (%default-syslog.conf): New variable. (syslog-service): Use it. Turn into a regular procedure. (guix-service, udev-rules-union, kvm-udev-rule, udev-service, device-mapping-service, swap-service): Likewise. * gnu/services/databases.scm (%default-postgres-hba, %default-postgres-ident): Use 'plain-file' instead of 'text-file'. (%default-postgres-config): Use 'mixed-text-file' instead of 'text-file*'. (postgresql-service): Use 'program-file' instead of 'gexp->script'. Turn into a regular procedure. * gnu/services/desktop.scm (dbus-configuration-directory): Use 'computed-file' instead of 'gexp->derivation'. (upower-configuration-file, geoclue-configuration-file, elogind-configuration-file): Use 'plain-file' instead of 'text-file'. (dbus-service, upower-service, colord-service, geoclue-service, polkit-service, elogind-service): Turn into regular procedures. (%desktop-services): Remove use of 'mlet' when iterating on %BASE-SERVICES. * gnu/services/lirc.scm (lirc-service): Turn into a regular procedure. * gnu/services/networking.scm (static-networking-service, dhcp-client-service, ntp-service, tor-service, bitlbee-service, wicd-service): Likewise. * gnu/services/ssh.scm (lsh-service): Likewise. * gnu/services/web.scm (nginx-service): Likewise. * gnu/services/xorg.scm (xorg-configuration-file): Use 'mixed-text-file' instead of 'text-file*'. (xorg-start-command, slim-service): Turn into regular procedures. (xinitrc): Use 'program-file' instead of 'gexp->script'. * gnu/system/install.scm (cow-store-service, configuration-template-service): Turn into regular procedures. * gnu/system.scm (other-file-system-services, device-mapping-services, swap-services, essential-services, operating-system-services, user-shells, operating-system-accounts): Remove now unnecessary 'mlet' and turn into regular procedures. (operating-system-etc-directory, operating-system-activation-script, operating-system-boot-script): Adjust accordingly. * doc/guix.texi (Base Services, Networking Services, X Window, Desktop Services, Database Services, Web Services, Various Services, Name Service Switch): Adjust accordingly.
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