X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTerminal.hs;h=064c5ff87e27af60f328f14e9c4d3f05f19cf10d;hb=ac3a81eb6d0f8ca4e212752d5b390a4fc220cceb;hp=cd35bf0e08bc1c2e85083f8568054845471a5110;hpb=95e23e65db31cf51c9f207a6b447da19920ee1a1;p=dead%2Fhtsn.git

diff --git a/src/Terminal.hs b/src/Terminal.hs
index cd35bf0..064c5ff 100644
--- a/src/Terminal.hs
+++ b/src/Terminal.hs
@@ -1,6 +1,9 @@
 module Terminal (
-  putGreenLn,
-  report_error)
+  display_debug,
+  display_error,
+  display_info,
+  display_sent,
+  display_warning )
 where
 
 import Control.Monad.IO.Class (MonadIO(..))
@@ -9,37 +12,68 @@ import System.Console.ANSI (
   Color(..),
   ColorIntensity( Vivid ),
   ConsoleLayer( Foreground ),
-  setSGR )
-import System.IO ( Handle, hPutStrLn, stderr )
+  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
+-- | 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
 
--- | 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
 
--- | Report an error (to stderr).
-report_error :: String -> IO ()
-report_error = hPutRedLn stderr
+-- | 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