add stopPropellorMessage

4 files changed, 43 insertions, 19 deletions

diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs
index 2f9b1684..3ab783bf 100644
--- a/src/Propellor/Exception.hs
+++ b/src/Propellor/Exception.hs
@@ -3,30 +3,13 @@
 module Propellor.Exception where
 
 import Propellor.Types
+import Propellor.Types.Exception
 import Propellor.Message
 import Utility.Exception
 
 import Control.Exception (AsyncException)
 import Control.Monad.Catch
 import Control.Monad.IO.Class (MonadIO)
-import Data.Typeable
-
--- | Normally when an exception is encountered while propellor is 
--- ensuring a property, the property fails, but propellor robustly 
--- continues on to the next property.
---
--- This is the only exception that will stop the entire propellor run,
--- preventing any subsequent properties of the Host from being ensured.
--- (When propellor is running in a container in a Host, this exception only
--- stops the propellor run in the container; the outer run in the Host
--- continues.)
---
--- You should only throw this exception when things are so badly messed up
--- that it's best for propellor to not try to do anything else.
-data StopPropellorException = StopPropellorException String
-	deriving (Show, Typeable)
-
-instance Exception StopPropellorException
 
 -- | Catches all exceptions (except for `StopPropellorException` and
 -- `AsyncException`) and returns FailedChange.
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 $
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index feb08694..161f2aee 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -86,7 +86,7 @@ toKernelNewerThan ver =
 				-- under a kernel version that's too old.
 				-- E.g. Sbuild.built can fail
 				-- to add the config line `union-type=overlay`
-				else throwM $ StopPropellorException $ 
+				else stopPropellorMessage $
 					"kernel newer than "
 					++ ver
 					++ " not installed"
diff --git a/src/Propellor/Types/Exception.hs b/src/Propellor/Types/Exception.hs
new file mode 100644
index 00000000..3a810d55
--- /dev/null
+++ b/src/Propellor/Types/Exception.hs
@@ -0,0 +1,21 @@
+module Propellor.Types.Exception where
+
+import Data.Typeable
+import Control.Exception
+
+-- | Normally when an exception is encountered while propellor is 
+-- ensuring a property, the property fails, but propellor robustly 
+-- continues on to the next property.
+--
+-- This is the only exception that will stop the entire propellor run,
+-- preventing any subsequent properties of the Host from being ensured.
+-- (When propellor is running in a container in a Host, this exception only
+-- stops the propellor run in the container; the outer run in the Host
+-- continues.)
+--
+-- You should only throw this exception when things are so badly messed up
+-- that it's best for propellor to not try to do anything else.
+data StopPropellorException = StopPropellorException String
+	deriving (Show, Typeable)
+
+instance Exception StopPropellorException