services: herd: Actions return a list of results.

Fixes a regression introduced in
0642838b2e.

* gnu/services/herd.scm (invoke-action): Explain that we get a list of
results.
(current-services): Expect a list of result and use the first one.
(unload-service, %load-file, eval-there): Likewise.
This commit is contained in:
Ludovic Courtès 2017-08-23 00:03:06 +02:00
parent 4e58740aff
commit 7d14082d56
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 19 additions and 14 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -136,7 +136,8 @@ does not denote an error."
(define* (invoke-action service action arguments cont) (define* (invoke-action service action arguments cont)
"Invoke ACTION on SERVICE with ARGUMENTS. On success, call CONT with the "Invoke ACTION on SERVICE with ARGUMENTS. On success, call CONT with the
result. Otherwise return #f." list of results (one result per instance with the name SERVICE). Otherwise
return #f."
(with-shepherd sock (with-shepherd sock
(write `(shepherd-command (version 0) (write `(shepherd-command (version 0)
(action ,action) (action ,action)
@ -186,7 +187,11 @@ of pairs."
"Return the list of currently defined Shepherd services, represented as "Return the list of currently defined Shepherd services, represented as
<live-service> objects. Return #f if the list of services could not be <live-service> objects. Return #f if the list of services could not be
obtained." obtained."
(with-shepherd-action 'root ('status) services (with-shepherd-action 'root ('status) results
;; We get a list of results, one for each service with the name 'root'.
;; In practice there's only one such service though.
(match results
((services _ ...)
(match services (match services
((('service ('version 0 _ ...) _ ...) ...) ((('service ('version 0 _ ...) _ ...) ...)
(map (lambda (service) (map (lambda (service)
@ -194,22 +199,22 @@ obtained."
(live-service provides requires running))) (live-service provides requires running)))
services)) services))
(x (x
#f)))) #f))))))
(define (unload-service service) (define (unload-service service)
"Unload SERVICE, a symbol name; return #t on success." "Unload SERVICE, a symbol name; return #t on success."
(with-shepherd-action 'root ('unload (symbol->string service)) result (with-shepherd-action 'root ('unload (symbol->string service)) result
result)) (first result)))
(define (%load-file file) (define (%load-file file)
"Load FILE in the Shepherd." "Load FILE in the Shepherd."
(with-shepherd-action 'root ('load file) result (with-shepherd-action 'root ('load file) result
result)) (first result)))
(define (eval-there exp) (define (eval-there exp)
"Eval EXP in the Shepherd." "Eval EXP in the Shepherd."
(with-shepherd-action 'root ('eval (object->string exp)) result (with-shepherd-action 'root ('eval (object->string exp)) result
result)) (first result)))
(define (load-services files) (define (load-services files)
"Load and register the services from FILES, where FILES contain code that "Load and register the services from FILES, where FILES contain code that