src/Terminal.hs

   1 module Terminal (
   2   hPutRedLn,
   3   putGreenLn)
   4 where
   5
   6 import Control.Monad.IO.Class (MonadIO(..))
   7 import System.Console.ANSI (
   8   SGR( SetColor ),
   9   Color(..),
  10   ColorIntensity( Vivid ),
  11   ConsoleLayer( Foreground ),
  12   setSGR )
  13 import System.IO ( Handle, hPutStrLn )
  14
  15 -- | Perform a computation (anything in MonadIO) with the given
  16 --   graphics mode(s) enabled. Revert to the previous graphics mode
  17 --   after the computation has finished.
  18 with_sgr :: (MonadIO m) => [SGR] -> m a -> m a
  19 with_sgr sgrs computation = do
  20   liftIO $ setSGR sgrs
  21   x <- computation
  22   liftIO $ setSGR []
  23   return x
  24
  25 -- | Perform a computation (anything in MonadIO) with the terminal
  26 --   output set to a certain color. Reset to the default color after
  27 --   the computation has finished.
  28 with_color :: (MonadIO m) => Color -> m a -> m a
  29 with_color color =
  30   with_sgr [SetColor Foreground Vivid color]
  31
  32
  33 -- | Output the given line to the given handle, in red. The silly
  34 --   camelCase name is for consistency with e.g. hPutStrLn.
  35 hPutRedLn :: Handle -> String -> IO ()
  36 hPutRedLn h = with_color Red . hPutStrLn h
  37
  38 -- | Output the given line to stdout. The silly camelCase name is for
  39 --   consistency with e.g. putStrLn.
  40 putGreenLn :: String -> IO ()
  41 putGreenLn = with_color Green . putStrLn