]> gitweb.michael.orlitzky.com - dead/htsn.git/blob - src/Network/Services/TSN/Terminal.hs
Move the TSN namespace (Xml.hs and FeedHosts.hs) into the top level.
[dead/htsn.git] / 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