2021-06-10 11:34:18 +00:00
|
|
|
#lang syndicate
|
|
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
|
|
|
|
;; Generic Racket events.
|
|
|
|
|
2021-06-25 07:45:38 +00:00
|
|
|
(provide (all-from-out syndicate/schemas/gen/racketEvent))
|
2021-06-10 11:34:18 +00:00
|
|
|
|
|
|
|
(require syndicate/driver-support)
|
2021-06-25 07:45:38 +00:00
|
|
|
(require syndicate/schemas/gen/racketEvent)
|
|
|
|
(require syndicate/schemas/gen/dataspacePatterns)
|
2021-06-10 11:34:18 +00:00
|
|
|
|
|
|
|
(define-logger syndicate/drivers/racket-event)
|
|
|
|
|
2021-06-17 12:57:06 +00:00
|
|
|
(provide-service [ds]
|
|
|
|
(at ds
|
|
|
|
(during/spawn (Observe (:pattern (RacketEvent ,(DLit $embedded-event) ,_)) _)
|
|
|
|
#:name (embedded-value embedded-event)
|
|
|
|
(define event (embedded-value embedded-event))
|
|
|
|
(linked-thread
|
|
|
|
#:name (list event 'thread)
|
|
|
|
(lambda (facet)
|
|
|
|
(let loop ()
|
|
|
|
(sync (handle-evt event
|
|
|
|
(lambda args
|
|
|
|
(turn! facet (lambda () (send! ds (RacketEvent event args))))
|
|
|
|
(loop))))))))))
|