aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-04-15 23:53:23 +0200
committerLudovic Courtès <ludo@gnu.org>2017-04-16 00:48:08 +0200
commit1bb895eabf74a1e571887eb1521915e668a5c28d (patch)
tree7e8e5210a8c3f26d07ac46992f05740430436fe5
parentf816dba680124860022ba155cf5a6a337739ef11 (diff)
downloadguix-1bb895eabf74a1e571887eb1521915e668a5c28d.tar
guix-1bb895eabf74a1e571887eb1521915e668a5c28d.tar.gz
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.
-rw-r--r--doc/guix.texi39
-rw-r--r--gnu/services.scm62
-rw-r--r--tests/services.scm11
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 *)))