#lang scheme
(require
 scheme/port)

(define-values (current-terminal-input-port current-terminal-output-port)
  (let-values ([(in out) (open-input-output-file "/dev/tty" #:exists 'update)])
    (values (make-parameter in) (make-parameter out))))

(define (read-stty-result in)
  (cond
    [(regexp-try-match #px"^([^\\s=;]+)\\s*=\\s*([^\\s;]+)[\\s;]*" in)
     => (match-lambda
          [(list _ key value)
           (map bytes->string/utf-8 (list key value))])]
    [(regexp-try-match #px"^([^\\s;]+)(?:\\s+baud)?[\\s;]*" in)
     => (match-lambda
          [(list _ command)
           (bytes->string/utf-8 command)])]
    [else
     (read-line in)]))

(define (stty [commands '("--save")] [terminal (current-terminal-input-port)])
  (let-values ([(child in out err) (apply subprocess #f terminal #f "/bin/stty" commands)])
    (let ([results (flatten (port->list read-stty-result in))]
          [message (port->string err)])
      (subprocess-wait child)
      (if (zero? (subprocess-status child))
          (if (null? results)
              (void)
              results)
          (error 'stty "could not perform ~e: ~a" commands message)))))

(provide/contract
 [current-terminal-input-port (parameter/c (and/c input-port? terminal-port?))]
 [current-terminal-output-port (parameter/c (and/c output-port? terminal-port?))]
 [stty (->* () ((listof string?) (and/c input-port? terminal-port?)) (or/c (listof string?) void?))])