From 44bf67b7a2da75ef80e32d6409cc41a6ab8b6ffe Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 24 Dec 2016 15:14:05 -0400 Subject: GHC's fileSystemEncoding is used for all String IO, to avoid encoding-related crashes in eg, Propellor.Property.File. --- src/Utility/Exception.hs | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) (limited to 'src/Utility/Exception.hs') diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs index f6551b45..67c2e85d 100644 --- a/src/Utility/Exception.hs +++ b/src/Utility/Exception.hs @@ -1,6 +1,6 @@ {- Simple IO exception handling (and some more) - - - Copyright 2011-2015 Joey Hess + - Copyright 2011-2016 Joey Hess - - License: BSD-2-clause -} @@ -10,6 +10,7 @@ module Utility.Exception ( module X, + giveup, catchBoolIO, catchMaybeIO, catchDefaultIO, @@ -28,9 +29,11 @@ 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) +#ifdef MIN_VERSION_GLASGOW_HASKELL +#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0) import Control.Exception (SomeAsyncException) #endif +#endif import Control.Monad import Control.Monad.IO.Class (liftIO, MonadIO) import System.IO.Error (isDoesNotExistError, ioeGetErrorType) @@ -38,6 +41,21 @@ import GHC.IO.Exception (IOErrorType(..)) import Utility.Data +{- Like error, this throws an exception. Unlike error, if this exception + - is not caught, it won't generate a backtrace. So use this for situations + - where there's a problem that the user is excpected to see in some + - circumstances. -} +giveup :: [Char] -> a +#ifdef MIN_VERSION_base +#if MIN_VERSION_base(4,9,0) +giveup = errorWithoutStackTrace +#else +giveup = error +#endif +#else +giveup = error +#endif + {- Catches IO errors and returns a Bool -} catchBoolIO :: MonadCatch m => m Bool -> m Bool catchBoolIO = catchDefaultIO False @@ -77,8 +95,10 @@ 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) +#ifdef MIN_VERSION_GLASGOW_HASKELL +#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0) , M.Handler (\ (e :: SomeAsyncException) -> throwM e) +#endif #endif , M.Handler (\ (e :: SomeException) -> onerr e) ] -- cgit v1.3-2-g0d8e