diff options
| -rw-r--r-- | doc/guix.texi | 39 | ||||
| -rw-r--r-- | gnu/services.scm | 62 | ||||
| -rw-r--r-- | tests/services.scm | 11 |
3 files changed, 103 insertions, 9 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index bf46f89bf2..fdd71141f0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -15555,11 +15555,12 @@ with a simple example, the service type for the Guix build daemon (extensions (list (service-extension shepherd-root-service-type guix-shepherd-service) (service-extension account-service-type guix-accounts) - (service-extension activation-service-type guix-activation))))) + (service-extension activation-service-type guix-activation))) + (default-value (guix-configuration)))) @end example @noindent -It defines two things: +It defines three things: @enumerate @item @@ -15572,6 +15573,9 @@ service, returns a list of objects to extend the service of that type. Every service type has at least one service extension. The only exception is the @dfn{boot service type}, which is the ultimate service. + +@item +Optionally, a default value for instances of this type. @end enumerate In this example, @var{guix-service-type} extends three services: @@ -15607,7 +15611,13 @@ A service of this type is instantiated like this: The second argument to the @code{service} form is a value representing the parameters of this specific service instance. @xref{guix-configuration-type, @code{guix-configuration}}, for -information about the @code{guix-configuration} data type. +information about the @code{guix-configuration} data type. When the +value is omitted, the default value specified by +@code{guix-service-type} is used: + +@example +(service guix-service-type) +@end example @var{guix-service-type} is quite simple because it extends other services but is not extensible itself. @@ -15670,10 +15680,31 @@ Services}). This section provides a reference on how to manipulate services and service types. This interface is provided by the @code{(gnu services)} module. -@deffn {Scheme Procedure} service @var{type} @var{value} +@deffn {Scheme Procedure} service @var{type} [@var{value}] Return a new service of @var{type}, a @code{<service-type>} object (see below.) @var{value} can be any object; it represents the parameters of this particular service instance. + +When @var{value} is omitted, the default value specified by @var{type} +is used; if @var{type} does not specify a default value, an error is +raised. + +For instance, this: + +@example +(service openssh-service-type) +@end example + +@noindent +is equivalent to this: + +@example +(service openssh-service-type + (openssh-configuration)) +@end example + +In both cases the result is an instance of @code{openssh-service-type} +with the default configuration. @end deffn @deffn {Scheme Procedure} service? @var{obj} diff --git a/gnu/services.scm b/gnu/services.scm index af4cffe819..b1b53fd18b 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -25,6 +25,7 @@ #:use-module (guix profiles) #:use-module (guix sets) #:use-module (guix ui) + #:use-module ((guix utils) #:select (source-properties->location)) #:use-module (guix modules) #:use-module (gnu packages base) #:use-module (gnu packages bash) @@ -47,6 +48,7 @@ service-type-extensions service-type-compose service-type-extend + service-type-default-value service service? @@ -60,6 +62,9 @@ fold-services service-error? + missing-value-service-error? + missing-value-service-error-type + missing-value-service-error-location missing-target-service-error? missing-target-service-error-service missing-target-service-error-target-type @@ -119,6 +124,10 @@ (target service-extension-target) ;<service-type> (compute service-extension-compute)) ;params -> params +(define &no-default-value + ;; Value used to denote service types that have no associated default value. + '(no default value)) + (define-record-type* <service-type> service-type make-service-type service-type? (name service-type-name) ;symbol (for debugging) @@ -132,7 +141,11 @@ ;; Extend the services' own parameters with the extension composition. (extend service-type-extend ;list of Any -> parameters - (default #f))) + (default #f)) + + ;; Optional default value for instances of this type. + (default-value service-type-default-value ;Any + (default &no-default-value))) (define (write-service-type type port) (format port "#<service-type ~a ~a>" @@ -143,11 +156,53 @@ ;; Services of a given type. (define-record-type <service> - (service type value) + (make-service type value) service? (type service-kind) (value service-value)) +(define-syntax service + (syntax-rules () + "Return a service instance of TYPE. The service value is VALUE or, if +omitted, TYPE's default value." + ((_ type value) + (make-service type value)) + ((_ type) + (%service-with-default-value (current-source-location) + type)))) + +(define (%service-with-default-value location type) + "Return a instance of service type TYPE with its default value, if any. If +TYPE does not have a default value, an error is raised." + ;; TODO: Currently this is a run-time error but with a little bit macrology + ;; we could turn it into an expansion-time error. + (let ((default (service-type-default-value type))) + (if (eq? default &no-default-value) + (let ((location (source-properties->location location))) + (raise + (condition + (&missing-value-service-error (type type) (location location)) + (&message + (message (format #f (_ "~a: no value specified \ +for service of type '~a'") + (location->string location) + (service-type-name type))))))) + (service type default)))) + +(define-condition-type &service-error &error + service-error?) + +(define-condition-type &missing-value-service-error &service-error + missing-value-service-error? + (type missing-value-service-error-type) + (location missing-value-service-error-location)) + + + +;;; +;;; Helpers. +;;; + (define service-parameters ;; Deprecated alias. service-value) @@ -541,9 +596,6 @@ kernel." ;;; Service folding. ;;; -(define-condition-type &service-error &error - service-error?) - (define-condition-type &missing-target-service-error &service-error missing-target-service-error? (service missing-target-service-error-service) diff --git a/tests/services.scm b/tests/services.scm index 7983427a7d..8484ee982a 100644 --- a/tests/services.scm +++ b/tests/services.scm @@ -31,6 +31,17 @@ (test-begin "services") +(test-equal "services, default value" + '(42 123 234 error) + (let* ((t1 (service-type (name 't1) (extensions '()))) + (t2 (service-type (name 't2) (extensions '()) + (default-value 42)))) + (list (service-value (service t2)) + (service-value (service t2 123)) + (service-value (service t1 234)) + (guard (c ((missing-value-service-error? c) 'error)) + (service t1))))) + (test-assert "service-back-edges" (let* ((t1 (service-type (name 't1) (extensions '()) (compose +) (extend *))) |