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

(provide linked-thread)

(require "engine.rkt")
(require (only-in racket/exn exn->string))

(define-logger syndicate/driver-support)

(define (linked-thread thread-proc
                       #:name [name (gensym 'linked-thread)]
                       #:peer [peer (ref (entity/stop-on-retract #:name (list name 'monitor)))]
                       #:custodian [c (make-custodian)])
  (define handle #f)
  (define armed? #t)

  (define (!)
    (when armed?
      (set! armed? #f)
      (log-syndicate/driver-support-info "~a shutdown" name)
      (turn-retract! this-turn handle)
      (queue-task! (actor-engine this-actor) (lambda () (custodian-shutdown-all c)))
      (actor-remove-exit-hook! this-actor !)))

  (on-stop (!))
  (actor-add-exit-hook! this-actor !)

  (log-syndicate/driver-support-info "~a startup" name)
  (set! handle
        (parameterize ((current-custodian c))
          (define facet this-facet)
          (turn-assert! this-turn
                        peer
                        (embedded
                         (thread (lambda ()
                                   (with-handlers
                                       ([(lambda (_e) #t)
                                         (lambda (e)
                                           (log-syndicate/driver-support-error "~a crashed:\n~a"
                                                                               name
                                                                               (exn->string e))
                                           (void))])
                                     (thread-proc facet))
                                   (turn! facet !))))))))