diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Propellor/Exception.hs | 13 | ||||
| -rw-r--r-- | src/Propellor/Property.hs | 8 | ||||
| -rw-r--r-- | src/Propellor/Types/Exception.hs | 5 | ||||
| -rw-r--r-- | src/Utility/Exception.hs | 8 |
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) ] |
