Racket implementation of Dataspaces and Syndicate.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

87 lines
3.0 KiB

#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: