IO.hs

module UI.Terminal.IO
  ( module UI.Terminal.IO
  , S.stdin
  , S.stdout
  , S.BufferMode (..)
  ) where

import Data.Text (Text)
import Data.Text.IO as T
import qualified System.IO as S
import qualified System.Console.ANSI as A
import Control.Monad.IO.Class

class Monad m => HasTerminal m where
  setCursorPosition :: Int -> Int -> m ()
  hideCursor :: m ()
  showCursor :: m ()
  putText :: Text -> m ()
  putTextFlush :: Text -> m ()
  hFlush :: m ()
  hSetEcho :: S.Handle -> Bool -> m ()
  hSetBuffering :: S.Handle -> S.BufferMode -> m ()
  hGetChar :: m Char
  hWaitForInput :: m Bool
  clearscreen :: m ()
  clearline :: m ()

instance (Monad m, MonadIO m) => HasTerminal m where
  setCursorPosition x y = do
    liftIO $ A.setCursorPosition y x
    hFlush
  hideCursor = liftIO A.hideCursor
  showCursor = do
    liftIO A.showCursor
    hFlush
  putText t = liftIO $ do
    T.putStr t
  putTextFlush t = do
    putText t
    hFlush
  hFlush = liftIO $ S.hFlush S.stdout
  hSetEcho h b = liftIO $ S.hSetEcho h b
  hGetChar = liftIO $ S.hGetChar S.stdin
  hSetBuffering h b = liftIO $ S.hSetBuffering h b
  hWaitForInput = liftIO $ S.hWaitForInput S.stdin 0
  clearscreen = do
    liftIO A.clearScreen
    hFlush
  clearline = liftIO $ A.hClearFromCursorToLineEnd S.stdout