~ruther/guix-local

7d14082d56462f7bef4254d65a21fd265fbce471 — Ludovic Courtès 8 years ago 4e58740
services: herd: Actions return a list of results.

Fixes a regression introduced in
0642838b2e9ab2bd988dccb64b9e1130006347bf.

* 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.
1 files changed, 19 insertions(+), 14 deletions(-)

M gnu/services/herd.scm
M gnu/services/herd.scm => gnu/services/herd.scm +19 -14
@@ 1,5 1,5 @@
;;; 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>
;;;
;;; This file is part of GNU Guix.


@@ 136,7 136,8 @@ does not denote an error."

(define* (invoke-action service action arguments cont)
  "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
    (write `(shepherd-command (version 0)
                              (action ,action)


@@ 186,30 187,34 @@ of pairs."
  "Return the list of currently defined Shepherd services, represented as
<live-service> objects.  Return #f if the list of services could not be
obtained."
  (with-shepherd-action 'root ('status) services
    (match services
      ((('service ('version 0 _ ...) _ ...) ...)
       (map (lambda (service)
              (alist-let* service (provides requires running)
                (live-service provides requires running)))
            services))
      (x
       #f))))
  (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
         ((('service ('version 0 _ ...) _ ...) ...)
          (map (lambda (service)
                 (alist-let* service (provides requires running)
                   (live-service provides requires running)))
               services))
         (x
          #f))))))

(define (unload-service service)
  "Unload SERVICE, a symbol name; return #t on success."
  (with-shepherd-action 'root ('unload (symbol->string service)) result
    result))
    (first result)))

(define (%load-file file)
  "Load FILE in the Shepherd."
  (with-shepherd-action 'root ('load file) result
    result))
    (first result)))

(define (eval-there exp)
  "Eval EXP in the Shepherd."
  (with-shepherd-action 'root ('eval (object->string exp)) result
    result))
    (first result)))

(define (load-services files)
  "Load and register the services from FILES, where FILES contain code that