drivers/racket-event.rkt

syndicate/drivers/racket-event.rkt

@@ -0,0 +1,30 @@
+#lang syndicate
+;;; SPDX-License-Identifier: LGPL-3.0-or-later
+;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
+
+;; Generic Racket events.
+
+(provide (all-from-out syndicate/schemas/gen/racket-event)
+         spawn-racket-event-driver)
+
+(require syndicate/driver-support)
+(require syndicate/schemas/gen/racket-event)
+(require syndicate/schemas/gen/dataspace-patterns)
+
+(define-logger syndicate/drivers/racket-event)
+
+(define (spawn-racket-event-driver ds)
+  (at ds
+    (during/spawn (Observe (:pattern (RacketEvent ,(DLit $embedded-event) ,_)) _)
+      #:name (embedded-value embedded-event)
+      (define event (embedded-value embedded-event))
+      (on-start (log-syndicate/drivers/racket-event-debug "started listening: ~v" event))
+      (on-stop  (log-syndicate/drivers/racket-event-debug "stopped listening: ~v" 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))))))))))

syndicate/schemas/racket-event.prs

@@ -0,0 +1,3 @@
+version 1 .
+
+RacketEvent = <racket-event @source #!any @event #!any>.