framing.rkt

#lang racket/base

(require racket/require
         (multi-in racket (contract function)))

(define executor (make-will-executor))
(void (thread (λ () (let loop () (will-execute executor) (loop)))))

(define frame? any/c)

(define/contract (make-framing-channel in read-frame)
  (-> input-port? (-> input-port? (or/c frame? exn?))
      (or/c frame? exn?))
  (define ch (make-channel))
  (define (framing-thread-thunk)
    (with-handlers ([(const #t) (curry channel-put ch)])
      (for ([v (in-port read-frame in)])
        (channel-put ch v))
      (channel-put ch eof)))
  (define framing-thread (thread framing-thread-thunk))
  (will-register executor ch (λ (_) (break-thread framing-thread)))
  ch)