summaryrefslogtreecommitdiff
path: root/src/Propellor/Exception.hs
diff options
context:
space:
mode:
authorJoey Hess2016-06-13 18:39:40 -0400
committerJoey Hess2016-06-13 18:40:00 -0400
commit7d18d057eb4f2e4ad7f7fd578b3e33564f1c8c7a (patch)
tree92bcc8cf868838b09344744a6539ae11d1c1ad31 /src/Propellor/Exception.hs
parent7d6a78c317a8382044682a2183b6524d0d8c050a (diff)
improve exception handling
* Improve exception handling. A property that threw a non-IOException used to stop the whole propellor run. Now, all non-async exceptions only make the property that threw them fail. (Implicit API change) * Added StopPropellorException which can be used in the unsual case where a failure of one property should stop propellor from trying to ensure any other properties. * tryPropellor returns Either SomeException a now (API change)
Diffstat (limited to 'src/Propellor/Exception.hs')
-rw-r--r--src/Propellor/Exception.hs42
1 files changed, 36 insertions, 6 deletions
diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs
index 2b38af0c..2f9b1684 100644
--- a/src/Propellor/Exception.hs
+++ b/src/Propellor/Exception.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Propellor.Exception where
@@ -6,13 +6,43 @@ import Propellor.Types
import Propellor.Message
import Utility.Exception
-import Control.Exception (IOException)
+import Control.Exception (AsyncException)
+import Control.Monad.Catch
+import Control.Monad.IO.Class (MonadIO)
+import Data.Typeable
--- | Catches IO exceptions and returns FailedChange.
-catchPropellor :: Propellor Result -> Propellor Result
+-- | 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.
+catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result
catchPropellor a = either err return =<< tryPropellor a
where
err e = warningMessage (show e) >> return FailedChange
-tryPropellor :: Propellor a -> Propellor (Either IOException a)
-tryPropellor = try
+catchPropellor' :: MonadCatch m => m a -> (SomeException -> m a) -> m a
+catchPropellor' a onerr = a `catches`
+ [ Handler (\ (e :: AsyncException) -> throwM e)
+ , Handler (\ (e :: StopPropellorException) -> throwM e)
+ , Handler (\ (e :: SomeException) -> onerr e)
+ ]
+
+-- | Catches all exceptions (except for `StopPropellorException` and
+-- `AsyncException`).
+tryPropellor :: MonadCatch m => m a -> m (Either SomeException a)
+tryPropellor a = (Right <$> a) `catchPropellor'` (pure . Left)