summaryrefslogtreecommitdiff
path: root/src/Propellor/Message.hs
diff options
context:
space:
mode:
authorJoey Hess2014-05-14 19:41:05 -0400
committerJoey Hess2014-05-14 19:41:05 -0400
commit7115d1ec162b4059b3e8e8f84bd8d5898c1db025 (patch)
tree42c1cce54e890e1d56484794ab33129132d8fee2 /src/Propellor/Message.hs
parentffe371a9d42cded461236e972a24a142419d7fc4 (diff)
moved source code to src
This is to work around OSX's brain-damange regarding filename case insensitivity. Avoided moving config.hs, because it's a config file. Put in a symlink to make build work.
Diffstat (limited to 'src/Propellor/Message.hs')
-rw-r--r--src/Propellor/Message.hs51
1 files changed, 51 insertions, 0 deletions
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
new file mode 100644
index 00000000..780471c3
--- /dev/null
+++ b/src/Propellor/Message.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.Message where
+
+import System.Console.ANSI
+import System.IO
+import System.Log.Logger
+import "mtl" Control.Monad.Reader
+
+import Propellor.Types
+
+-- | Shows a message while performing an action, with a colored status
+-- display.
+actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r
+actionMessage desc a = do
+ liftIO $ do
+ setTitle $ "propellor: " ++ desc
+ hFlush stdout
+
+ r <- a
+
+ liftIO $ do
+ setTitle "propellor: running"
+ let (msg, intensity, color) = getActionResult r
+ putStr $ desc ++ " ... "
+ colorLine intensity color msg
+ hFlush stdout
+
+ return r
+
+warningMessage :: MonadIO m => String -> m ()
+warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s
+
+colorLine :: ColorIntensity -> Color -> String -> IO ()
+colorLine intensity color msg = do
+ setSGR [SetColor Foreground intensity color]
+ putStr msg
+ setSGR []
+ -- Note this comes after the color is reset, so that
+ -- the color set and reset happen in the same line.
+ putStrLn ""
+ hFlush stdout
+
+errorMessage :: String -> IO a
+errorMessage s = do
+ liftIO $ colorLine Vivid Red $ "** error: " ++ s
+ error "Cannot continue!"
+
+-- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
+debug :: [String] -> IO ()
+debug = debugM "propellor" . unwords