me
/
guix
Archived
1
0
Fork 0
Code

services: Make <service-type> 'description' field mandatory. 

* gnu/services.scm (<service-type>)[description]: Remove default value.
* tests/services.scm: Add 'description' field to each 'service-type' form.
Ludovic Courtès 2022-05-13 23:40:34 +02:00
parent 9a5d686923
commit 3948ac25b1
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
gnu/services.scm
View File

@ -183,8 +183,7 @@
(default &no-default-value)) (default &no-default-value))
;; Meta-data. ;; Meta-data.
(description service-type-description ;string (description service-type-description) ;string
(default #f))
(location service-type-location ;<location> (location service-type-location ;<location>
(default (and=> (current-source-location) (default (and=> (current-source-location)
source-properties->location)) source-properties->location))

38
tests/services.scm
View File

@ -30,8 +30,10 @@
(test-equal "services, default value" (test-equal "services, default value"
'(42 123 234 error) '(42 123 234 error)
(let* ((t1 (service-type (name 't1) (extensions '()))) (let* ((t1 (service-type (name 't1) (extensions '())
(description "")))
(t2 (service-type (name 't2) (extensions '()) (t2 (service-type (name 't2) (extensions '())
(description "")
(default-value 42)))) (default-value 42))))
(list (service-value (service t2)) (list (service-value (service t2))
(service-value (service t2 123)) (service-value (service t2 123))
@ -40,13 +42,13 @@
(service t1))))) (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 '()) (description "")
(compose +) (extend *))) (compose +) (extend *)))
(t2 (service-type (name 't2) (t2 (service-type (name 't2) (description "")
(extensions (extensions
(list (service-extension t1 (const '())))) (list (service-extension t1 (const '()))))
(compose +) (extend *))) (compose +) (extend *)))
(t3 (service-type (name 't3) (t3 (service-type (name 't3) (description "")
(extensions (extensions
(list (service-extension t2 identity) (list (service-extension t2 identity)
(service-extension t1 list))))) (service-extension t1 list)))))
@ -63,16 +65,16 @@
;; from services of type T3; 'xyz 60' comes from the service of type T2, ;; from services of type T3; 'xyz 60' comes from the service of type T2,
;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4. ;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4.
'(initial-value 5 4 3 2 1 xyz 60) '(initial-value 5 4 3 2 1 xyz 60)
(let* ((t1 (service-type (name 't1) (extensions '()) (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(compose concatenate) (compose concatenate)
(extend cons))) (extend cons)))
(t2 (service-type (name 't2) (t2 (service-type (name 't2) (description "")
(extensions (extensions
(list (service-extension t1 (list (service-extension t1
(cut list 'xyz <>)))) (cut list 'xyz <>))))
(compose (cut reduce + 0 <>)) (compose (cut reduce + 0 <>))
(extend *))) (extend *)))
(t3 (service-type (name 't3) (t3 (service-type (name 't3) (description "")
(extensions (extensions
(list (service-extension t2 identity) (list (service-extension t2 identity)
(service-extension t1 list))))) (service-extension t1 list)))))
@ -86,10 +88,10 @@
(service-value r)))) (service-value r))))
(test-assert "fold-services, ambiguity" (test-assert "fold-services, ambiguity"
(let* ((t1 (service-type (name 't1) (extensions '()) (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(compose concatenate) (compose concatenate)
(extend cons))) (extend cons)))
(t2 (service-type (name 't2) (t2 (service-type (name 't2) (description "")
(extensions (extensions
(list (service-extension t1 list))))) (list (service-extension t1 list)))))
(s (service t2 42))) (s (service t2 42)))
@ -105,8 +107,8 @@
#f))) #f)))
(test-assert "fold-services, missing target" (test-assert "fold-services, missing target"
(let* ((t1 (service-type (name 't1) (extensions '()))) (let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
(t2 (service-type (name 't2) (t2 (service-type (name 't2) (description "")
(extensions (extensions
(list (service-extension t1 list))))) (list (service-extension t1 list)))))
(s (service t2 42))) (s (service t2 42)))
@ -119,11 +121,11 @@
#f))) #f)))
(test-assert "instantiate-missing-services" (test-assert "instantiate-missing-services"
(let* ((t1 (service-type (name 't1) (extensions '()) (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(default-value 'dflt) (default-value 'dflt)
(compose concatenate) (compose concatenate)
(extend cons))) (extend cons)))
(t2 (service-type (name 't2) (t2 (service-type (name 't2) (description "")
(extensions (extensions
(list (service-extension t1 list))))) (list (service-extension t1 list)))))
(s1 (service t1 'hey!)) (s1 (service t1 'hey!))
@ -135,17 +137,17 @@
(instantiate-missing-services (list s1 s2)))))) (instantiate-missing-services (list s1 s2))))))
(test-assert "instantiate-missing-services, indirect" (test-assert "instantiate-missing-services, indirect"
(let* ((t1 (service-type (name 't1) (extensions '()) (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(default-value 'dflt) (default-value 'dflt)
(compose concatenate) (compose concatenate)
(extend cons))) (extend cons)))
(t2 (service-type (name 't2) (t2 (service-type (name 't2) (description "")
(default-value 'dflt2) (default-value 'dflt2)
(compose concatenate) (compose concatenate)
(extend cons) (extend cons)
(extensions (extensions
(list (service-extension t1 list))))) (list (service-extension t1 list)))))
(t3 (service-type (name 't3) (t3 (service-type (name 't3) (description "")
(extensions (extensions
(list (service-extension t2 list))))) (list (service-extension t2 list)))))
(s1 (service t1)) (s1 (service t1))
@ -160,8 +162,8 @@
(instantiate-missing-services (list s2 s3)))))) (instantiate-missing-services (list s2 s3))))))
(test-assert "instantiate-missing-services, no default value" (test-assert "instantiate-missing-services, no default value"
(let* ((t1 (service-type (name 't1) (extensions '()))) (let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
(t2 (service-type (name 't2) (t2 (service-type (name 't2) (description "")
(extensions (extensions
(list (service-extension t1 list))))) (list (service-extension t1 list)))))
(s (service t2 42))) (s (service t2 42)))