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