src/Network/Services/TSN/Terminal.hs

   1 module Network.Services.TSN.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 -- | Write the given String to a handle in color. The funnyCaps are
  37 --   for synergy with putstrLn and friends.
  38 --
  39 hPutStrColor :: Handle -> Color -> String -> IO ()
  40 hPutStrColor h c = with_color h c . hPutStr h
  41
  42
  43 -- | Write the given line to a handle in color. The funnyCaps are for
  44 --   synergy with putstrLn and friends.
  45 --
  46 hPutStrColorLn :: Handle -> Color -> String -> IO ()
  47 hPutStrColorLn h c s = hPutStrColor h c (s ++ "\n")
  48
  49
  50 -- | Display text sent to the feed on the console. Don't automatically
  51 --   append a newline.
  52 --
  53 display_sent :: String -> IO ()
  54 display_sent = hPutStrColor stdout Green
  55
  56
  57 -- | Display debug text on the console. Don't automatically append a
  58 --   newline in case the raw text is needed for, uh, debugging.
  59 --
  60 display_debug :: String -> IO ()
  61 display_debug = putStr
  62
  63
  64 -- | Display an informational message on the console.
  65 --
  66 display_info :: String -> IO ()
  67 display_info = hPutStrColorLn stdout Cyan
  68
  69
  70 -- | Display a warning on the console. Uses stderr instead of stdout.
  71 --
  72 display_warning :: String -> IO ()
  73 display_warning = hPutStrColorLn stderr Yellow
  74
  75
  76 -- | Display an error on the console. Uses stderr instead of stdout.
  77 --
  78 display_error :: String -> IO ()
  79 display_error = hPutStrColorLn stderr Red