module Terminal (
- hPutRedLn,
- putGreenLn)
+ display_debug,
+ display_error,
+ display_info,
+ display_sent,
+ display_warning )
where
import Control.Monad.IO.Class (MonadIO(..))
Color(..),
ColorIntensity( Vivid ),
ConsoleLayer( Foreground ),
- setSGR )
-import System.IO ( Handle, hPutStrLn )
+ 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) => [SGR] -> m a -> m a
-with_sgr sgrs computation = do
- liftIO $ setSGR sgrs
+with_sgr :: (MonadIO m) => Handle -> [SGR] -> m a -> m a
+with_sgr h sgrs computation = do
+ liftIO $ hSetSGR h sgrs
x <- computation
- liftIO $ setSGR []
+ liftIO $ hSetSGR h []
return x
--- | Perform a computation (anything in MonadIO) with the terminal
--- output set to a certain color. Reset to the default color after
--- the computation has finished.
-with_color :: (MonadIO m) => Color -> m a -> m a
-with_color color =
- with_sgr [SetColor Foreground Vivid color]
+-- | 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]
--- | Output the given line to the given handle, in red. The silly
--- camelCase name is for consistency with e.g. hPutStrLn.
-hPutRedLn :: Handle -> String -> IO ()
-hPutRedLn h = with_color Red . hPutStrLn h
+hPutStrColor :: Handle -> Color -> String -> IO ()
+hPutStrColor h c = with_color h c . hPutStr h
--- | Output the given line to stdout. The silly camelCase name is for
--- consistency with e.g. putStrLn.
-putGreenLn :: String -> IO ()
-putGreenLn = with_color Green . putStrLn
+hPutStrColorLn :: Handle -> Color -> String -> IO ()
+hPutStrColorLn h c s = hPutStrColor h c (s ++ "\n")
+
+-- | Don't automatically append a newline.
+display_sent :: String -> IO ()
+display_sent = hPutStrColor stdout Green
+
+display_debug :: String -> IO ()
+display_debug = putStr
+
+display_info :: String -> IO ()
+display_info = hPutStrColorLn stdout Cyan
+
+display_warning :: String -> IO ()
+display_warning = hPutStrColorLn stderr Yellow
+
+display_error :: String -> IO ()
+display_error = hPutStrColorLn stderr Red