From 490249b919aaf82527b81c88c88350fd478dbed9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 13 Jun 2016 18:56:52 -0400 Subject: add stopPropellorMessage --- src/Propellor/Exception.hs | 19 +------------------ src/Propellor/Message.hs | 20 ++++++++++++++++++++ src/Propellor/Property/Reboot.hs | 2 +- src/Propellor/Types/Exception.hs | 21 +++++++++++++++++++++ 4 files changed, 43 insertions(+), 19 deletions(-) create mode 100644 src/Propellor/Types/Exception.hs (limited to 'src') 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 -- cgit v1.3-2-g0d8e