--- /dev/null
+module 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.
+--
+display_debug :: String -> IO ()
+display_debug = putStr
+
+
+-- | Display an informational message on the console.
+--
+display_info :: String -> IO ()
+display_info = hPutStrColorLn stdout Cyan
+
+
+-- | Display a warning on the console. Uses stderr instead of stdout.
+--
+display_warning :: String -> IO ()
+display_warning = hPutStrColorLn stderr Yellow
+
+
+-- | Display an error on the console. Uses stderr instead of stdout.
+--
+display_error :: String -> IO ()
+display_error = hPutStrColorLn stderr Red