88 lines
3.0 KiB
Racket
88 lines
3.0 KiB
Racket
#lang racket/base
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
(provide (all-from-out syndicate/schemas/service)
|
|
|
|
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)
|
|
(require syndicate/schemas/service)
|
|
|
|
(define-logger syndicate/service)
|
|
|
|
(define-syntax-parameter registry-dataspace
|
|
(lambda (stx)
|
|
(raise-syntax-error 'registry-dataspace "Illegal use" stx)))
|
|
|
|
(define-syntax with-services
|
|
(syntax-rules ()
|
|
[(_ [] body ...)
|
|
(begin body ...)]
|
|
[(_ [service-name more-services ...] body ...)
|
|
(at registry-dataspace
|
|
(during (ServiceRunning 'service-name)
|
|
(with-services [more-services ...] body ...)))]))
|
|
|
|
(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)])
|
|
(at dataspace (assert (ServiceRunning service-name)))
|
|
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]
|
|
(with-services [syndicate/drivers/stream
|
|
syndicate/drivers/tcp
|
|
syndicate/drivers/timer]
|
|
body ...))]))
|
|
|
|
(define (spawn-service-manager ds)
|
|
(spawn #:name 'syndicate/service
|
|
#:daemon? #t
|
|
(at ds
|
|
(during (Observe (:pattern (ServiceRunning ,(DLit $service-name))) _)
|
|
(assert (RequireService service-name)))
|
|
|
|
(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:
|