diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-01-21 00:05:09 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-21 00:24:03 +0100 |
commit | d466b1fc8221a6224fe7ded53a828f9c29ed9457 (patch) | |
tree | 5180831a10c380d7eca1e8c0abc5b09d49a3a38c /gnu/services.scm | |
parent | bc58201ec22aeb07b61dc1e482d6a57868436eef (diff) | |
download | guix-d466b1fc8221a6224fe7ded53a828f9c29ed9457.tar.gz |
services: Missing services are automatically instantiated.
This simplifies OS configuration: users no longer need to be aware of what a given service depends on. See the discussion at <https://lists.gnu.org/archive/html/guix-devel/2018-01/msg00114.html>. * gnu/services.scm (missing-target-error): New procedure. (service-back-edges): Use it. (instantiate-missing-services): New procedure. * gnu/system.scm (operating-system-services): Call 'instantiate-missing-services'. * tests/services.scm ("instantiate-missing-services") ("instantiate-missing-services, no default value"): New tests. * gnu/services/version-control.scm (cgit-service-type)[extensions]: Add FCGIWRAP-SERVICE-TYPE. * gnu/tests/version-control.scm (%cgit-os): Remove NGINX-SERVICE-TYPE and FCGIWRAP-SERVICE-TYPE instances. * doc/guix.texi (Log Rotation): Remove 'mcron-service-type' in example. (Miscellaneous Services): Remove 'nginx-service-type' and 'fcgiwrap-service-type' in Cgit example.
Diffstat (limited to 'gnu/services.scm')
-rw-r--r-- | gnu/services.scm | 59 |
1 files changed, 48 insertions, 11 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index 15fc6dcb49..b020d971fd 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -24,6 +24,7 @@ #:use-module (guix records) #:use-module (guix profiles) #:use-module (guix discovery) + #:use-module (guix combinators) #:use-module (guix sets) #:use-module (guix ui) #:use-module ((guix utils) #:select (source-properties->location)) @@ -66,6 +67,7 @@ simple-service modify-services service-back-edges + instantiate-missing-services fold-services service-error? @@ -630,6 +632,18 @@ kernel." (service ambiguous-target-service-error-service) (target-type ambiguous-target-service-error-target-type)) +(define (missing-target-error service target-type) + (raise + (condition (&missing-target-service-error + (service service) + (target-type target-type)) + (&message + (message + (format #f (G_ "no target of type '~a' for service '~a'") + (service-type-name target-type) + (service-type-name + (service-kind service)))))))) + (define (service-back-edges services) "Return a procedure that, when passed a <service>, returns the list of <service> objects that depend on it." @@ -642,16 +656,7 @@ kernel." ((target) (vhash-consq target service edges)) (() - (raise - (condition (&missing-target-service-error - (service service) - (target-type target-type)) - (&message - (message - (format #f (G_ "no target of type '~a' for service '~a'") - (service-type-name target-type) - (service-type-name - (service-kind service)))))))) + (missing-target-error service target-type)) (x (raise (condition (&ambiguous-target-service-error @@ -669,6 +674,38 @@ kernel." (lambda (node) (reverse (vhash-foldq* cons '() node edges))))) +(define (instantiate-missing-services services) + "Return SERVICES, a list, augmented with any services targeted by extensions +and missing from SERVICES. Only service types with a default value can be +instantiated; other missing services lead to a +'&missing-target-service-error'." + (define (adjust-service-list svc result instances) + (fold2 (lambda (extension result instances) + (define target-type + (service-extension-target extension)) + + (match (vhash-assq target-type instances) + (#f + (let ((default (service-type-default-value target-type))) + (if (eq? &no-default-value default) + (missing-target-error svc target-type) + (let ((new (service target-type))) + (values (cons new result) + (vhash-consq target-type new instances)))))) + (_ + (values result instances)))) + result + instances + (service-type-extensions (service-kind svc)))) + + (let ((instances (fold (lambda (service result) + (vhash-consq (service-kind service) service + result)) + vlist-null services))) + (fold2 adjust-service-list + services instances + services))) + (define* (fold-services services #:key (target-type system-service-type)) "Fold SERVICES by propagating their extensions down to the root of type |