Terminal.hs

-- | Terminal output functions for displaying informational
--   messages. The output is color-coded according to severity, and is
--   designed at the moment for consoles with a dark background.
--
module Network.Services.TSN.Terminal (
  display_debug,
  display_error,
  display_info,
  display_sent,
  display_warning )
where

import Control.Monad.IO.Class (MonadIO(..))
import System.Console.ANSI (
  SGR( SetColor ),
  Color(..),
  ColorIntensity( Vivid ),
  ConsoleLayer( Foreground ),
  hSetSGR )
import System.IO ( Handle, hPutStr, stderr, stdout )

-- | Perform a computation (anything in MonadIO) with the given
--   graphics mode(s) enabled. Revert to the previous graphics mode
--   after the computation has finished.
with_sgr :: (MonadIO m) => Handle -> [SGR] -> m a -> m a
with_sgr h sgrs computation = do
  liftIO $ hSetSGR h sgrs
  x <- computation
  liftIO $ hSetSGR h []
  return x

-- | Perform a computation (anything in MonadIO) with the output set
--   to a certain color. Reset to the default color after the
--   computation has finished.
with_color :: (MonadIO m) => Handle -> Color -> m a -> m a
with_color h color =
  with_sgr h [SetColor Foreground Vivid color]


-- | Write the given String to a handle in color. The funnyCaps are
--   for synergy with putstrLn and friends.
--
hPutStrColor :: Handle -> Color -> String -> IO ()
hPutStrColor h c = with_color h c . hPutStr h


-- | Write the given line to a handle in color. The funnyCaps are for
--   synergy with putstrLn and friends.
--
hPutStrColorLn :: Handle -> Color -> String -> IO ()
hPutStrColorLn h c s = hPutStrColor h c (s ++ "\n")


-- | Display text sent to the feed on the console. Don't automatically
--   append a newline.
--
display_sent :: String -> IO ()
display_sent = hPutStrColor stdout Green


-- | Display debug text on the console. Don't automatically append a
--   newline in case the raw text is needed for, uh, debugging. The
--   text color is not altered.
--
display_debug :: String -> IO ()
display_debug = putStr


-- | Display an informational message on the console in cyan.
--
display_info :: String -> IO ()
display_info = hPutStrColorLn stdout Cyan


-- | Display a warning on the console in yello. Uses stderr instead of
--   stdout.
--
display_warning :: String -> IO ()
display_warning = hPutStrColorLn stderr Yellow


-- | Display an error on the console in red. Uses stderr instead of
--   stdout.
--
display_error :: String -> IO ()
display_error = hPutStrColorLn stderr Red