~ruther/guix-local

33033a620e64d64bc549b4472e2f4db61e801d18 — Ludovic Courtès 8 years ago 7175aba
services: shepherd: Make 'shepherd-configuration-file' non-monadic.

Suggested by atw on #guix.

* gnu/services/shepherd.scm (shepherd-service-file): Use 'scheme-file'
instead of 'gexp->file'.
(shepherd-configuration-file): Likewise, and adjust to non-monadic
style.
(shepherd-boot-gexp): Adjust accordingly.
* guix/scripts/system.scm (upgrade-shepherd-services): Use
'lower-object' in addition to 'shepherd-service-file'.
2 files changed, 22 insertions(+), 20 deletions(-)

M gnu/services/shepherd.scm
M guix/scripts/system.scm
M gnu/services/shepherd.scm => gnu/services/shepherd.scm +18 -18
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.


@@ 66,7 66,7 @@


(define (shepherd-boot-gexp services)
  (mlet %store-monad ((shepherd-conf (shepherd-configuration-file services)))
  (with-monad %store-monad
    (return #~(begin
                ;; Keep track of the booted system.
                (false-if-exception (delete-file "/run/booted-system"))


@@ 84,7 84,8 @@

                ;; Start shepherd.
                (execl #$(file-append shepherd "/bin/shepherd")
                       "shepherd" "--config" #$shepherd-conf)))))
                       "shepherd" "--config"
                       #$(shepherd-configuration-file services))))))

(define shepherd-root-service-type
  (service-type


@@ 203,25 204,24 @@ stored."

(define (shepherd-service-file service)
  "Return a file defining SERVICE."
  (gexp->file (shepherd-service-file-name service)
              (with-imported-modules %default-imported-modules
                #~(begin
                    (use-modules #$@(shepherd-service-modules service))

                    (make <service>
                      #:docstring '#$(shepherd-service-documentation service)
                      #:provides '#$(shepherd-service-provision service)
                      #:requires '#$(shepherd-service-requirement service)
                      #:respawn? '#$(shepherd-service-respawn? service)
                      #:start #$(shepherd-service-start service)
                      #:stop #$(shepherd-service-stop service))))))
  (scheme-file (shepherd-service-file-name service)
               (with-imported-modules %default-imported-modules
                 #~(begin
                     (use-modules #$@(shepherd-service-modules service))

                     (make <service>
                       #:docstring '#$(shepherd-service-documentation service)
                       #:provides '#$(shepherd-service-provision service)
                       #:requires '#$(shepherd-service-requirement service)
                       #:respawn? '#$(shepherd-service-respawn? service)
                       #:start #$(shepherd-service-start service)
                       #:stop #$(shepherd-service-stop service))))))

(define (shepherd-configuration-file services)
  "Return the shepherd configuration file for SERVICES."
  (assert-valid-graph services)

  (mlet %store-monad ((files (mapm %store-monad
                                   shepherd-service-file services)))
  (let ((files (map shepherd-service-file services)))
    (define config
      #~(begin
          (use-modules (srfi srfi-34)


@@ 252,7 252,7 @@ stored."
                                       (filter shepherd-service-auto-start?
                                               services)))))))

    (gexp->file "shepherd.conf" config)))
    (scheme-file "shepherd.conf" config)))

(define* (shepherd-service-lookup-procedure services
                                            #:optional

M guix/scripts/system.scm => guix/scripts/system.scm +4 -2
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>


@@ 331,7 331,9 @@ bring the system down."
            (let ((to-load-names  (map shepherd-service-canonical-name to-load))
                  (to-start       (filter shepherd-service-auto-start? to-load)))
              (info (G_ "loading new services:~{ ~a~}...~%") to-load-names)
              (mlet %store-monad ((files (mapm %store-monad shepherd-service-file
              (mlet %store-monad ((files (mapm %store-monad
                                               (compose lower-object
                                                        shepherd-service-file)
                                               to-load)))
                ;; Here we assume that FILES are exactly those that were computed
                ;; as part of the derivation that built OS, which is normally the