syndicate-rkt/syndicate/drivers/racket-event.rkt

#lang syndicate
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021-2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

;; Generic Racket events.

(provide (all-from-out syndicate/schemas/racketEvent))

(require syndicate/driver-support)
(require syndicate/schemas/racketEvent)
(require syndicate/schemas/dataspacePatterns)

(define-logger syndicate/drivers/racket-event)

(provide-service [ds]
  (at ds
    (during/spawn (Observe (:pattern (RacketEvent ,(Pattern-lit $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))))))))))