src/Terminal.hs

   1 module Terminal (
   2   display_debug,
   3   display_error,
   4   display_info,
   5   display_sent,
   6   display_warning )
   7 where
   8
   9 import Control.Monad.IO.Class (MonadIO(..))
  10 import System.Console.ANSI (
  11   SGR( SetColor ),
  12   Color(..),
  13   ColorIntensity( Vivid ),
  14   ConsoleLayer( Foreground ),
  15   hSetSGR )
  16 import System.IO ( Handle, hPutStr, stderr, stdout )
  17
  18 -- | Perform a computation (anything in MonadIO) with the given
  19 --   graphics mode(s) enabled. Revert to the previous graphics mode
  20 --   after the computation has finished.
  21 with_sgr :: (MonadIO m) => Handle -> [SGR] -> m a -> m a
  22 with_sgr h sgrs computation = do
  23   liftIO $ hSetSGR h sgrs
  24   x <- computation
  25   liftIO $ hSetSGR h []
  26   return x
  27
  28 -- | Perform a computation (anything in MonadIO) with the output set
  29 --   to a certain color. Reset to the default color after the
  30 --   computation has finished.
  31 with_color :: (MonadIO m) => Handle -> Color -> m a -> m a
  32 with_color h color =
  33   with_sgr h [SetColor Foreground Vivid color]
  34
  35
  36 hPutStrColor :: Handle -> Color -> String -> IO ()
  37 hPutStrColor h c = with_color h c . hPutStr h
  38
  39 hPutStrColorLn :: Handle -> Color -> String -> IO ()
  40 hPutStrColorLn h c s = hPutStrColor h c (s ++ "\n")
  41
  42 -- | Don't automatically append a newline.
  43 display_sent :: String -> IO ()
  44 display_sent = hPutStrColor stdout Green
  45
  46 display_debug :: String -> IO ()
  47 display_debug = putStr
  48
  49 display_info :: String -> IO ()
  50 display_info = hPutStrColorLn stdout Cyan
  51
  52 display_warning :: String -> IO ()
  53 display_warning = hPutStrColorLn stderr Yellow
  54
  55 display_error :: String -> IO ()
  56 display_error = hPutStrColorLn stderr Red