50 lines
2.2 KiB
Racket
50 lines
2.2 KiB
Racket
#lang syndicate
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
(provide port-lines-source
|
|
port-sink)
|
|
|
|
(require (only-in racket/port read-line-evt))
|
|
|
|
(require "tcp.rkt") ;; ugh, lots of tcp.rkt actually belongs in this file
|
|
(require syndicate/drivers/racket-event)
|
|
(require syndicate/service)
|
|
|
|
(define (port-lines-source ds [port (current-input-port)]
|
|
#:initial-credit [initial-credit 0]
|
|
#:name [name (list 'port-lines-source (object-name port))]
|
|
#:line-mode [line-mode (LineMode-lf)])
|
|
(at ds (assert (RequireService 'syndicate/drivers/racket-event)))
|
|
(define-field credit initial-credit)
|
|
(define-field sink #f)
|
|
(at ds
|
|
(on (message #:when (and (sink) (positive? (credit))) (RacketEvent (read-line-evt port) $vs))
|
|
(credit (- (credit) 1))
|
|
(match (car vs)
|
|
[(? eof-object?) (send-eof (sink))]
|
|
[line (send-line (sink) line line-mode)])))
|
|
(make-source #:name name
|
|
#:on-connect sink
|
|
#:on-credit (lambda (amount mode)
|
|
(if (equal? amount (CreditAmount-unbounded))
|
|
(credit +inf.0)
|
|
(match mode
|
|
[(Mode-lines _)
|
|
(credit (+ (credit) (CreditAmount-count-value amount)))]
|
|
[_ (void)])))))
|
|
|
|
(define (port-sink [port (current-output-port)]
|
|
#:name [name (list 'port-sink (object-name port))])
|
|
(make-sink #:name name
|
|
#:on-connect (lambda (source) (send-credit source (CreditAmount-unbounded) (Mode-bytes)))
|
|
#:on-eof (lambda () (close-output-port port))
|
|
#:on-data (lambda (data mode)
|
|
(when (bytes? data)
|
|
(write-bytes data port)
|
|
(match mode
|
|
[(Mode-bytes) (void)]
|
|
[(Mode-lines (LineMode-lf)) (write-bytes #"\n" port)]
|
|
[(Mode-lines (LineMode-crlf)) (write-bytes #"\r\n" port)])
|
|
(flush-output port)))))
|