summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Exception.hs13
-rw-r--r--src/Propellor/Property.hs8
-rw-r--r--src/Propellor/Types/Exception.hs5
-rw-r--r--src/Utility/Exception.hs8
4 files changed, 24 insertions, 10 deletions
diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs
index 3ab783bf..463402e4 100644
--- a/src/Propellor/Exception.hs
+++ b/src/Propellor/Exception.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
module Propellor.Exception where
@@ -8,11 +8,15 @@ import Propellor.Message
import Utility.Exception
import Control.Exception (AsyncException)
+#if MIN_VERSION_base(4,7,0)
+import Control.Exception (SomeAsyncException)
+#endif
import Control.Monad.Catch
import Control.Monad.IO.Class (MonadIO)
+import Prelude
-- | Catches all exceptions (except for `StopPropellorException` and
--- `AsyncException`) and returns FailedChange.
+-- `AsyncException` and `SomeAsyncException`) and returns FailedChange.
catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result
catchPropellor a = either err return =<< tryPropellor a
where
@@ -21,6 +25,9 @@ catchPropellor a = either err return =<< tryPropellor a
catchPropellor' :: MonadCatch m => m a -> (SomeException -> m a) -> m a
catchPropellor' a onerr = a `catches`
[ Handler (\ (e :: AsyncException) -> throwM e)
+#if MIN_VERSION_base(4,7,0)
+ , Handler (\ (e :: SomeAsyncException) -> throwM e)
+#endif
, Handler (\ (e :: StopPropellorException) -> throwM e)
, Handler (\ (e :: SomeException) -> onerr e)
]
@@ -28,4 +35,4 @@ catchPropellor' a onerr = a `catches`
-- | Catches all exceptions (except for `StopPropellorException` and
-- `AsyncException`).
tryPropellor :: MonadCatch m => m a -> m (Either SomeException a)
-tryPropellor a = (Right <$> a) `catchPropellor'` (pure . Left)
+tryPropellor a = (return . Right =<< a) `catchPropellor'` (return . Left)
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index f23fd3ba..7ee9397e 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -54,7 +54,7 @@ import System.Posix.Files
import qualified Data.Hash.MD5 as MD5
import Data.List
import Control.Applicative
-import Data.Foldable
+import Data.Foldable hiding (and, elem)
import Prelude
import Propellor.Types
@@ -83,7 +83,7 @@ flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
go _ _ True = return NoChange
go satisfy flagfile False = do
r <- satisfy
- when (r == MadeChange) $ liftIO $
+ when (r == MadeChange) $ liftIO $
unlessM (doesFileExist flagfile) $ do
createDirectoryIfMissing True (takeDirectory flagfile)
writeFile flagfile ""
@@ -279,7 +279,7 @@ pickOS
, SingI c
-- Would be nice to have this constraint, but
-- union will not generate metatypes lists with the same
- -- order of OS's as is used everywhere else. So,
+ -- order of OS's as is used everywhere else. So,
-- would need a type-level sort.
--, Union a b ~ c
)
@@ -297,7 +297,7 @@ pickOS a b = c `addChildren` [toChildProperty a, toChildProperty b]
then getSatisfy b
else unsupportedOS'
matching Nothing _ = False
- matching (Just o) p =
+ matching (Just o) p =
Targeting (systemToTargetOS o)
`elem`
fromSing (proptype p)
diff --git a/src/Propellor/Types/Exception.hs b/src/Propellor/Types/Exception.hs
index 3a810d55..9fdcab93 100644
--- a/src/Propellor/Types/Exception.hs
+++ b/src/Propellor/Types/Exception.hs
@@ -1,10 +1,11 @@
+{-# LANGUAGE DeriveDataTypeable #-}
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
+-- | 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,
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index e691f13b..f6551b45 100644
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -5,7 +5,7 @@
- License: BSD-2-clause
-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Exception (
@@ -28,6 +28,9 @@ module Utility.Exception (
import Control.Monad.Catch as X hiding (Handler)
import qualified Control.Monad.Catch as M
import Control.Exception (IOException, AsyncException)
+#if MIN_VERSION_base(4,7,0)
+import Control.Exception (SomeAsyncException)
+#endif
import Control.Monad
import Control.Monad.IO.Class (liftIO, MonadIO)
import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
@@ -74,6 +77,9 @@ bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)
catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
catchNonAsync a onerr = a `catches`
[ M.Handler (\ (e :: AsyncException) -> throwM e)
+#if MIN_VERSION_base(4,7,0)
+ , M.Handler (\ (e :: SomeAsyncException) -> throwM e)
+#endif
, M.Handler (\ (e :: SomeException) -> onerr e)
]