1 -- | Terminal output functions for displaying informational
2 -- messages. The output is color-coded according to severity, and is
3 -- designed at the moment for consoles with a dark background.
5 module Network.Services.TSN.Terminal (
13 import Control.Monad.IO.Class (MonadIO(..))
14 import System.Console.ANSI (
17 ColorIntensity( Vivid ),
18 ConsoleLayer( Foreground ),
20 import System.IO ( Handle, hPutStr, stderr, stdout )
22 -- | Perform a computation (anything in MonadIO) with the given
23 -- graphics mode(s) enabled. Revert to the previous graphics mode
24 -- after the computation has finished.
25 with_sgr :: (MonadIO m) => Handle -> [SGR] -> m a -> m a
26 with_sgr h sgrs computation = do
27 liftIO $ hSetSGR h sgrs
32 -- | Perform a computation (anything in MonadIO) with the output set
33 -- to a certain color. Reset to the default color after the
34 -- computation has finished.
35 with_color :: (MonadIO m) => Handle -> Color -> m a -> m a
37 with_sgr h [SetColor Foreground Vivid color]
40 -- | Write the given String to a handle in color. The funnyCaps are
41 -- for synergy with putstrLn and friends.
43 hPutStrColor :: Handle -> Color -> String -> IO ()
44 hPutStrColor h c = with_color h c . hPutStr h
47 -- | Write the given line to a handle in color. The funnyCaps are for
48 -- synergy with putstrLn and friends.
50 hPutStrColorLn :: Handle -> Color -> String -> IO ()
51 hPutStrColorLn h c s = hPutStrColor h c (s ++ "\n")
54 -- | Display text sent to the feed on the console. Don't automatically
57 display_sent :: String -> IO ()
58 display_sent = hPutStrColor stdout Green
61 -- | Display debug text on the console. Don't automatically append a
62 -- newline in case the raw text is needed for, uh, debugging. The
63 -- text color is not altered.
65 display_debug :: String -> IO ()
66 display_debug = putStr
69 -- | Display an informational message on the console in cyan.
71 display_info :: String -> IO ()
72 display_info = hPutStrColorLn stdout Cyan
75 -- | Display a warning on the console in yello. Uses stderr instead of
78 display_warning :: String -> IO ()
79 display_warning = hPutStrColorLn stderr Yellow
82 -- | Display an error on the console in red. Uses stderr instead of
85 display_error :: String -> IO ()
86 display_error = hPutStrColorLn stderr Red