services: Service types can now specify a default value for instances.

* gnu/services.scm (&no-default-value): New variable.
(<service-type>)[default-value]: New field.
(<service>): Rename constructor from 'service' to 'make-service'.
(service): New macro.
(%service-with-default-value): New procedure.
(&missing-value-service-error): New error condition.
* tests/services.scm ("services, default value"): New test.
* doc/guix.texi (Service Types and Services): Document 'default-value'.
(Service Reference): Explain default values.
This commit is contained in:
Ludovic Courtès 2017-04-15 23:53:23 +02:00
parent f816dba680
commit 1bb895eabf
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 103 additions and 9 deletions

View File

@ -15555,11 +15555,12 @@ with a simple example, the service type for the Guix build daemon
(extensions (extensions
(list (service-extension shepherd-root-service-type guix-shepherd-service) (list (service-extension shepherd-root-service-type guix-shepherd-service)
(service-extension account-service-type guix-accounts) (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 @end example
@noindent @noindent
It defines two things: It defines three things:
@enumerate @enumerate
@item @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 Every service type has at least one service extension. The only
exception is the @dfn{boot service type}, which is the ultimate service. exception is the @dfn{boot service type}, which is the ultimate service.
@item
Optionally, a default value for instances of this type.
@end enumerate @end enumerate
In this example, @var{guix-service-type} extends three services: 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 second argument to the @code{service} form is a value representing
the parameters of this specific service instance. the parameters of this specific service instance.
@xref{guix-configuration-type, @code{guix-configuration}}, for @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 @var{guix-service-type} is quite simple because it extends other
services but is not extensible itself. 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 services and service types. This interface is provided by the
@code{(gnu services)} module. @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 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 below.) @var{value} can be any object; it represents the parameters of
this particular service instance. 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 @end deffn
@deffn {Scheme Procedure} service? @var{obj} @deffn {Scheme Procedure} service? @var{obj}

View File

@ -25,6 +25,7 @@
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((guix utils) #:select (source-properties->location))
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
@ -47,6 +48,7 @@
service-type-extensions service-type-extensions
service-type-compose service-type-compose
service-type-extend service-type-extend
service-type-default-value
service service
service? service?
@ -60,6 +62,9 @@
fold-services fold-services
service-error? service-error?
missing-value-service-error?
missing-value-service-error-type
missing-value-service-error-location
missing-target-service-error? missing-target-service-error?
missing-target-service-error-service missing-target-service-error-service
missing-target-service-error-target-type missing-target-service-error-target-type
@ -119,6 +124,10 @@
(target service-extension-target) ;<service-type> (target service-extension-target) ;<service-type>
(compute service-extension-compute)) ;params -> params (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 (define-record-type* <service-type> service-type make-service-type
service-type? service-type?
(name service-type-name) ;symbol (for debugging) (name service-type-name) ;symbol (for debugging)
@ -132,7 +141,11 @@
;; Extend the services' own parameters with the extension composition. ;; Extend the services' own parameters with the extension composition.
(extend service-type-extend ;list of Any -> parameters (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) (define (write-service-type type port)
(format port "#<service-type ~a ~a>" (format port "#<service-type ~a ~a>"
@ -143,11 +156,53 @@
;; Services of a given type. ;; Services of a given type.
(define-record-type <service> (define-record-type <service>
(service type value) (make-service type value)
service? service?
(type service-kind) (type service-kind)
(value service-value)) (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 (define service-parameters
;; Deprecated alias. ;; Deprecated alias.
service-value) service-value)
@ -541,9 +596,6 @@ kernel."
;;; Service folding. ;;; Service folding.
;;; ;;;
(define-condition-type &service-error &error
service-error?)
(define-condition-type &missing-target-service-error &service-error (define-condition-type &missing-target-service-error &service-error
missing-target-service-error? missing-target-service-error?
(service missing-target-service-error-service) (service missing-target-service-error-service)

View File

@ -31,6 +31,17 @@
(test-begin "services") (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" (test-assert "service-back-edges"
(let* ((t1 (service-type (name 't1) (extensions '()) (let* ((t1 (service-type (name 't1) (extensions '())
(compose +) (extend *))) (compose +) (extend *)))