src/Terminal.hs

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