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