#lang racket/base

(require racket/port)

(provide cook-io)

(define clear-to-eol "\033[2K")
(define kill-line (string-append "\r" clear-to-eol))

(struct buffer (chars consume-next-linefeed?) #:transparent)

(define (buffer-empty? b)
  (null? (buffer-chars b)))

(define (buffer-adjust b new-chars)
  (struct-copy buffer b
	       [chars new-chars]
	       [consume-next-linefeed? #f]))

(define (buffer-contents b)
  (list->string (reverse (buffer-chars b))))

(define (update-buffer b key prompt k-eof k-complete k-ongoing)
  (case key
    ((#\backspace #\rubout) ;; backspace = ^H = code 8; delete = code 127
     (if (buffer-empty? b)
	 (k-ongoing b "")
	 (k-ongoing (buffer-adjust b (cdr (buffer-chars b))) "\b \b")))
    ((#\return) (k-complete (buffer-contents b) (buffer '() #t)))
    ((#\newline) (if (buffer-consume-next-linefeed? b)
		     (k-ongoing (struct-copy buffer b [consume-next-linefeed? #f]) "")
		     (k-complete (buffer-contents b) (buffer '() #f))))
    ((#\page) (k-ongoing b (string-append kill-line prompt (buffer-contents b))))
    ((#\004) ;; control-D, UNIX EOF
     (if (buffer-empty? b)
	 (k-eof)
	 (k-ongoing b "")))
    ((#\033) ;; escape
     (k-ongoing (buffer '() #f) (string-append kill-line prompt)))
    (else (if (char-iso-control? key)
	      (k-ongoing b "")
	      (k-ongoing (buffer-adjust b (cons key (buffer-chars b))) (string key))))))

(define (cook-io raw-in raw-out prompt)
  (define-values (cooked-in cooked-out) (make-pipe))
  (thread
   (lambda ()
     (let loop ((b (buffer '() #f)))
       (if (port-closed? cooked-out)
	   ;; our job here is
	   'done
	   (let ((s (read-string 1 raw-in)))
	     (if (eof-object? s)
		 (begin (close-output-port cooked-out)
			(loop b))
		 (begin (update-buffer b (string-ref s 0) prompt
				       (lambda ()
					 (close-output-port cooked-out)
					 (close-input-port raw-in))
				       (lambda (line new-b)
					 (write-string "\r\n" raw-out)
					 (write-string line cooked-out)
					 (newline cooked-out)
					 (loop new-b))
				       (lambda (new-b feedback)
					 (write-string feedback raw-out)
					 (loop new-b))))))))))
  (values cooked-in (cook-output raw-out)))

(define (cook-output raw-out)
  (define-values (cooked-in cooked-out) (make-pipe))
  (thread
   (lambda ()
     (define buffer (make-bytes 4096))
     (let loop ()
       (define count (read-bytes-avail! buffer cooked-in))
       (if (eof-object? count)
	   (begin (close-input-port cooked-in)
		  (close-output-port raw-out))
	   (let ((raw-data (regexp-replace* #"\n" (subbytes buffer 0 count) #"\r\n")))
	     (write-bytes raw-data raw-out)
	     (loop))))))
  cooked-out)