Add scaffolding to allow logging via syslog or a file.

[dead/htsn.git] / src / Terminal.hs

diff --git a/src/Terminal.hs b/src/Terminal.hs
index cd35bf0e08bc1c2e85083f8568054845471a5110..6031d62c5e9a7cdd3919099622c701cb6e9ad60f 100644 (file)
--- 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,45 @@ 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
+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")
 
--- | Report an error (to stderr).
-report_error :: String -> IO ()
-report_error = hPutRedLn stderr
+-- | 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