From be1c2c54d9f918f50f71c6d32a72d4498c07504c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 9 Sep 2015 09:17:31 +0200 Subject: 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 . * 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. --- gnu/system.scm | 104 ++++++++++++++++++++++++++------------------------------- 1 file changed, 48 insertions(+), 56 deletions(-) (limited to 'gnu/system.scm') 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 - (($ 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 + (($ 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 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 -- cgit v1.2.3