2021-06-17 12:57:06 +00:00
|
|
|
#lang racket/base
|
|
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
2022-01-16 08:48:18 +00:00
|
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021-2022 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
2021-06-17 12:57:06 +00:00
|
|
|
|
2021-07-01 07:40:52 +00:00
|
|
|
(provide (all-from-out syndicate/schemas/service)
|
2021-06-17 12:57:06 +00:00
|
|
|
|
|
|
|
with-services
|
|
|
|
provide-service
|
|
|
|
|
|
|
|
standard-actor-system
|
|
|
|
standard-actor-system/no-services)
|
|
|
|
|
|
|
|
(require racket/stxparam)
|
|
|
|
(require (for-syntax racket/base))
|
|
|
|
|
|
|
|
(require syndicate/syntax)
|
|
|
|
(require syndicate/pattern)
|
|
|
|
(require syndicate/dataspace)
|
2021-07-01 07:40:52 +00:00
|
|
|
(require syndicate/schemas/service)
|
2021-06-17 12:57:06 +00:00
|
|
|
|
|
|
|
(define-logger syndicate/service)
|
|
|
|
|
|
|
|
(define-syntax-parameter registry-dataspace
|
|
|
|
(lambda (stx)
|
|
|
|
(raise-syntax-error 'registry-dataspace "Illegal use" stx)))
|
|
|
|
|
|
|
|
(define-syntax with-services
|
2022-01-16 23:18:57 +00:00
|
|
|
(syntax-rules ()
|
|
|
|
[(_ [service-name ...] body ...)
|
|
|
|
(at registry-dataspace
|
|
|
|
(begin (log-syndicate/service-debug "Asserting ~v" (RequireService 'service-name))
|
|
|
|
(assert (RequireService 'service-name))) ...
|
|
|
|
(await-services [service-name ...] body ...))]))
|
|
|
|
|
|
|
|
(define-syntax await-services
|
2021-06-17 12:57:06 +00:00
|
|
|
(syntax-rules ()
|
|
|
|
[(_ [] body ...)
|
2022-01-16 23:18:57 +00:00
|
|
|
(begin (log-syndicate/service-debug "Ready!")
|
|
|
|
body ...)]
|
2021-06-17 12:57:06 +00:00
|
|
|
[(_ [service-name more-services ...] body ...)
|
2022-01-16 23:18:57 +00:00
|
|
|
(begin (log-syndicate/service-debug "Awaiting ~v" (ServiceState 'service-name (State-ready)))
|
|
|
|
(during (ServiceState 'service-name (State-ready))
|
|
|
|
(await-services [more-services ...] body ...)))]))
|
2021-06-17 12:57:06 +00:00
|
|
|
|
|
|
|
(define-syntax provide-service
|
|
|
|
(syntax-rules ()
|
|
|
|
[(_ [dataspace] body ...)
|
|
|
|
(module+ #%service
|
|
|
|
(provide #%service)
|
|
|
|
(define (#%service service-name dataspace)
|
|
|
|
(syntax-parameterize ([registry-dataspace (make-rename-transformer #'dataspace)])
|
2022-01-16 23:18:57 +00:00
|
|
|
(log-syndicate/service-debug "Providing ~v" (ServiceState service-name (State-ready)))
|
|
|
|
(at dataspace (assert (ServiceState service-name (State-ready))))
|
2021-06-17 12:57:06 +00:00
|
|
|
body ...)))]))
|
|
|
|
|
|
|
|
(define-syntax standard-actor-system/no-services
|
|
|
|
(syntax-rules ()
|
|
|
|
[(_ [dataspace] body ...)
|
|
|
|
(actor-system/dataspace (dataspace)
|
|
|
|
#:name 'standard-actor-system
|
|
|
|
(syntax-parameterize ([registry-dataspace (make-rename-transformer #'dataspace)])
|
|
|
|
(spawn-service-manager dataspace)
|
|
|
|
body ...))]))
|
|
|
|
|
|
|
|
(define-syntax standard-actor-system
|
|
|
|
(syntax-rules ()
|
|
|
|
[(_ [dataspace] body ...)
|
|
|
|
(standard-actor-system/no-services [dataspace]
|
2021-06-17 13:26:14 +00:00
|
|
|
(with-services [syndicate/drivers/stream
|
|
|
|
syndicate/drivers/tcp
|
2021-06-17 12:57:06 +00:00
|
|
|
syndicate/drivers/timer]
|
|
|
|
body ...))]))
|
|
|
|
|
|
|
|
(define (spawn-service-manager ds)
|
|
|
|
(spawn #:name 'syndicate/service
|
|
|
|
#:daemon? #t
|
|
|
|
(at ds
|
|
|
|
(during/spawn (RequireService $service-name)
|
|
|
|
#:name service-name
|
|
|
|
#:daemon? #t
|
|
|
|
(log-syndicate/service-info "Starting service ~a" service-name)
|
|
|
|
(define boot
|
|
|
|
(dynamic-require `(submod ,service-name #%service)
|
|
|
|
'#%service
|
|
|
|
(lambda () (error service-name "No service provided"))))
|
|
|
|
(boot service-name ds)
|
|
|
|
(on-stop (log-syndicate/service-info "Stopping service ~a" service-name))))))
|
|
|
|
|
|
|
|
;;---------------------------------------------------------------------------
|
|
|
|
;;; Local Variables:
|
|
|
|
;;; eval: (put 'provide-service 'racket-indent-function 1)
|
|
|
|
;;; eval: (put 'standard-actor-system 'racket-indent-function 1)
|
|
|
|
;;; eval: (put 'standard-actor-system/no-services 'racket-indent-function 1)
|
|
|
|
;;; End:
|