nptools-0.2.2: starecho.hs

import System.IO
import Control.Monad
import System.Environment

main :: IO ()
main = do hPutStrLn stderr "Listening..."
          hSetBuffering stdin NoBuffering
          hSetBuffering stderr NoBuffering
          hSetEcho stdin False
          args <- getArgs
          when (not . null $ args) $ hPutStrLn stderr "Usage: starecho\n\nThis programs reads on stdin, echoes to stderr, and finally prints the results on stdout."
          putStrLn =<< loop ""
  where
    -- `s' holds the accumulated read string
    loop s = do c <- getChar
                proc c s

    -- tells what to do with the current char
    proc '\n'   = finish
    proc '\DEL' = del
    proc '\b'   = del
    proc c      = lineAndLoop c

    -- show a line and continue reading
    lineAndLoop c s = puts (showLine c (length s)) >> loop (c : s)

    showLine c n = '\r' : replicate n '*' ++ [c]

    -- Erase a char, visually and internally.
    del (_ : c : s) = erase >> proc c s
    del _           = erase >> loop ""

    -- Clear the line and return the string
    finish s = do puts $ '\r' : replicate (length s) ' ' ++ ['\r']
                  return $ reverse s

    -- To erase the previous char, one first go back, draw a space,
    -- and go back again.
    erase = puts "\b \b"

    puts = hPutStr stderr