summaryrefslogtreecommitdiff
path: root/src/Propellor/Message.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Message.hs')
-rw-r--r--src/Propellor/Message.hs20
1 files changed, 20 insertions, 0 deletions
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 32625e6a..b7e96ec2 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -13,6 +13,7 @@ module Propellor.Message (
warningMessage,
infoMessage,
errorMessage,
+ stopPropellorMessage,
processChainOutput,
messagesDone,
createProcessConcurrent,
@@ -29,6 +30,7 @@ import Control.Applicative
import Prelude
import Propellor.Types
+import Propellor.Types.Exception
import Utility.PartialPrelude
import Utility.Monad
import Utility.Exception
@@ -105,11 +107,29 @@ warningMessage s = liftIO $
infoMessage :: MonadIO m => [String] -> m ()
infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls
+-- | Displays the error message in red, and throws an exception.
+--
+-- When used inside a property, the exception will only stop the current
+-- property from being ensured. Propellor will continue ensuring other
+-- properties.
errorMessage :: MonadIO m => String -> m a
errorMessage s = liftIO $ do
outputConcurrent =<< colorLine Vivid Red ("** error: " ++ s)
+ -- Normally this exception gets caught and is not displayed,
+ -- and propellor continues. So it's only displayed if not
+ -- caught, and so we say, cannot continue.
error "Cannot continue!"
+-- | Like `errorMessage`, but throws a `StopPropellorException`
+--
+-- Think twice before using this. Is the problem so bad that propellor
+-- cannot try to ensure other properties? If not, use `errorMessage`
+-- instead.
+stopPropellorMessage :: MonadIO m => String -> m a
+stopPropellorMessage s = liftIO $ do
+ outputConcurrent =<< colorLine Vivid Red ("** fatal error: " ++ s)
+ throwM $ StopPropellorException "Cannot continue!"
+
colorLine :: ColorIntensity -> Color -> String -> IO String
colorLine intensity color msg = concat <$> sequence
[ whenConsole $