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:
parent
f816dba680
commit
1bb895eabf
|
@ -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}
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 *)))
|
||||||
|
|
Loading…
Reference in New Issue