{-# LANGUAGE CPP #-}
module Control.Error.Util (
hush,
hushT,
note,
noteT,
hoistMaybe,
hoistEither,
(??),
(!?),
failWith,
failWithM,
bool,
(?:),
maybeT,
just,
nothing,
isJustT,
isNothingT,
isLeft,
isRight,
fmapR,
AllE(..),
AnyE(..),
isLeftT,
isRightT,
fmapRT,
exceptT,
bimapExceptT,
err,
errLn,
tryIO,
handleExceptT,
syncIO
) where
import Control.Applicative (Applicative, pure, (<$>))
import Control.Exception (IOException, SomeException, Exception)
import Control.Monad (liftM)
import Control.Monad.Catch (MonadCatch, try)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
import Data.Monoid (Monoid(mempty, mappend))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup
#endif
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import System.IO (stderr)
import qualified Control.Exception as Exception
import qualified Data.Text.IO
exceptT :: Monad m => (a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT :: forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT a -> m c
f b -> m c
g (ExceptT m (Either a b)
m) = m (Either a b)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either a b
z -> case Either a b
z of
Left a
a -> a -> m c
f a
a
Right b
b -> b -> m c
g b
b
{-# INLINEABLE exceptT #-}
bimapExceptT :: Functor m => (e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
bimapExceptT :: forall (m :: * -> *) e f a b.
Functor m =>
(e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
bimapExceptT e -> f
f a -> b
g (ExceptT m (Either e a)
m) = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either e a -> Either f b
h m (Either e a)
m)
where
h :: Either e a -> Either f b
h (Left e
e) = forall a b. a -> Either a b
Left (e -> f
f e
e)
h (Right a
a) = forall a b. b -> Either a b
Right (a -> b
g a
a)
{-# INLINEABLE bimapExceptT #-}
hoistEither :: Monad m => Either e a -> ExceptT e m a
hoistEither :: forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINEABLE hoistEither #-}
hush :: Either a b -> Maybe b
hush :: forall a b. Either a b -> Maybe b
hush = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
hushT :: (Monad m) => ExceptT a m b -> MaybeT m b
hushT :: forall (m :: * -> *) a b. Monad m => ExceptT a m b -> MaybeT m b
hushT = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. Either a b -> Maybe b
hush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
note :: a -> Maybe b -> Either a b
note :: forall a b. a -> Maybe b -> Either a b
note a
a = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left a
a) forall a b. b -> Either a b
Right
noteT :: (Monad m) => a -> MaybeT m b -> ExceptT a m b
noteT :: forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT a
a = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. a -> Maybe b -> Either a b
note a
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
hoistMaybe :: (Monad m) => Maybe b -> MaybeT m b
hoistMaybe :: forall (m :: * -> *) b. Monad m => Maybe b -> MaybeT m b
hoistMaybe = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
(??) :: Applicative m => Maybe a -> e -> ExceptT e m a
?? :: forall (m :: * -> *) a e.
Applicative m =>
Maybe a -> e -> ExceptT e m a
(??) Maybe a
a e
e = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Maybe b -> Either a b
note e
e Maybe a
a)
(!?) :: Applicative m => m (Maybe a) -> e -> ExceptT e m a
!? :: forall (m :: * -> *) a e.
Applicative m =>
m (Maybe a) -> e -> ExceptT e m a
(!?) m (Maybe a)
a e
e = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall a b. a -> Maybe b -> Either a b
note e
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a)
a)
(?:) :: Maybe a -> a -> a
Maybe a
maybeA ?: :: forall a. Maybe a -> a -> a
?: a
b = forall a. a -> Maybe a -> a
fromMaybe a
b Maybe a
maybeA
{-# INLINABLE (?:) #-}
infixr 0 ?:
failWith :: Applicative m => e -> Maybe a -> ExceptT e m a
failWith :: forall (m :: * -> *) e a.
Applicative m =>
e -> Maybe a -> ExceptT e m a
failWith e
e Maybe a
a = Maybe a
a forall (m :: * -> *) a e.
Applicative m =>
Maybe a -> e -> ExceptT e m a
?? e
e
failWithM :: Applicative m => e -> m (Maybe a) -> ExceptT e m a
failWithM :: forall (m :: * -> *) e a.
Applicative m =>
e -> m (Maybe a) -> ExceptT e m a
failWithM e
e m (Maybe a)
a = m (Maybe a)
a forall (m :: * -> *) a e.
Applicative m =>
m (Maybe a) -> e -> ExceptT e m a
!? e
e
bool :: a -> a -> Bool -> a
bool :: forall a. a -> a -> Bool -> a
bool a
a a
b = \Bool
c -> if Bool
c then a
b else a
a
{-# INLINABLE bool #-}
maybeT :: Monad m => m b -> (a -> m b) -> MaybeT m a -> m b
maybeT :: forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> MaybeT m a -> m b
maybeT m b
mb a -> m b
kb (MaybeT m (Maybe a)
ma) = m (Maybe a)
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
mb a -> m b
kb
just :: (Monad m) => a -> MaybeT m a
just :: forall (m :: * -> *) a. Monad m => a -> MaybeT m a
just a
a = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a))
nothing :: (Monad m) => MaybeT m a
nothing :: forall (m :: * -> *) a. Monad m => MaybeT m a
nothing = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
isJustT :: (Monad m) => MaybeT m a -> m Bool
isJustT :: forall (m :: * -> *) a. Monad m => MaybeT m a -> m Bool
isJustT = forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> MaybeT m a -> m b
maybeT (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (\a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
{-# INLINABLE isJustT #-}
isNothingT :: (Monad m) => MaybeT m a -> m Bool
isNothingT :: forall (m :: * -> *) a. Monad m => MaybeT m a -> m Bool
isNothingT = forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> MaybeT m a -> m b
maybeT (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (\a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
{-# INLINABLE isNothingT #-}
isLeft :: Either a b -> Bool
isLeft :: forall a b. Either a b -> Bool
isLeft = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
True) (forall a b. a -> b -> a
const Bool
False)
isRight :: Either a b -> Bool
isRight :: forall a b. Either a b -> Bool
isRight = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall a b. a -> b -> a
const Bool
True)
fmapR :: (a -> b) -> Either l a -> Either l b
fmapR :: forall a b l. (a -> b) -> Either l a -> Either l b
fmapR = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
newtype AllE e r = AllE { forall e r. AllE e r -> Either e r
runAllE :: Either e r }
#if MIN_VERSION_base(4,9,0)
instance (Semigroup e, Semigroup r) => Semigroup (AllE e r) where
AllE (Right r
x) <> :: AllE e r -> AllE e r -> AllE e r
<> AllE (Right r
y) = forall e r. Either e r -> AllE e r
AllE (forall a b. b -> Either a b
Right (r
x forall a. Semigroup a => a -> a -> a
<> r
y))
AllE (Right r
_) <> AllE (Left e
y) = forall e r. Either e r -> AllE e r
AllE (forall a b. a -> Either a b
Left e
y)
AllE (Left e
x) <> AllE (Right r
_) = forall e r. Either e r -> AllE e r
AllE (forall a b. a -> Either a b
Left e
x)
AllE (Left e
x) <> AllE (Left e
y) = forall e r. Either e r -> AllE e r
AllE (forall a b. a -> Either a b
Left (e
x forall a. Semigroup a => a -> a -> a
<> e
y))
#endif
instance (Monoid e, Monoid r) => Monoid (AllE e r) where
mempty :: AllE e r
mempty = forall e r. Either e r -> AllE e r
AllE (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty)
#if !(MIN_VERSION_base(4,11,0))
mappend (AllE (Right x)) (AllE (Right y)) = AllE (Right (mappend x y))
mappend (AllE (Right _)) (AllE (Left y)) = AllE (Left y)
mappend (AllE (Left x)) (AllE (Right _)) = AllE (Left x)
mappend (AllE (Left x)) (AllE (Left y)) = AllE (Left (mappend x y))
#endif
newtype AnyE e r = AnyE { forall e r. AnyE e r -> Either e r
runAnyE :: Either e r }
#if MIN_VERSION_base(4,9,0)
instance (Semigroup e, Semigroup r) => Semigroup (AnyE e r) where
AnyE (Right r
x) <> :: AnyE e r -> AnyE e r -> AnyE e r
<> AnyE (Right r
y) = forall e r. Either e r -> AnyE e r
AnyE (forall a b. b -> Either a b
Right (r
x forall a. Semigroup a => a -> a -> a
<> r
y))
AnyE (Right r
x) <> AnyE (Left e
_) = forall e r. Either e r -> AnyE e r
AnyE (forall a b. b -> Either a b
Right r
x)
AnyE (Left e
_) <> AnyE (Right r
y) = forall e r. Either e r -> AnyE e r
AnyE (forall a b. b -> Either a b
Right r
y)
AnyE (Left e
x) <> AnyE (Left e
y) = forall e r. Either e r -> AnyE e r
AnyE (forall a b. a -> Either a b
Left (e
x forall a. Semigroup a => a -> a -> a
<> e
y))
#endif
instance (Monoid e, Monoid r) => Monoid (AnyE e r) where
mempty :: AnyE e r
mempty = forall e r. Either e r -> AnyE e r
AnyE (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty)
#if !(MIN_VERSION_base(4,11,0))
mappend (AnyE (Right x)) (AnyE (Right y)) = AnyE (Right (mappend x y))
mappend (AnyE (Right x)) (AnyE (Left _)) = AnyE (Right x)
mappend (AnyE (Left _)) (AnyE (Right y)) = AnyE (Right y)
mappend (AnyE (Left x)) (AnyE (Left y)) = AnyE (Left (mappend x y))
#endif
isLeftT :: (Monad m) => ExceptT a m b -> m Bool
isLeftT :: forall (m :: * -> *) a b. Monad m => ExceptT a m b -> m Bool
isLeftT = forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT (\a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (\b
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
{-# INLINABLE isLeftT #-}
isRightT :: (Monad m) => ExceptT a m b -> m Bool
isRightT :: forall (m :: * -> *) a b. Monad m => ExceptT a m b -> m Bool
isRightT = forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT (\a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (\b
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
{-# INLINABLE isRightT #-}
fmapRT :: (Monad m) => (a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT :: forall (m :: * -> *) a b l.
Monad m =>
(a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
err :: Text -> IO ()
err :: Text -> IO ()
err = Handle -> Text -> IO ()
Data.Text.IO.hPutStr Handle
stderr
errLn :: Text -> IO ()
errLn :: Text -> IO ()
errLn = Handle -> Text -> IO ()
Data.Text.IO.hPutStrLn Handle
stderr
tryIO :: MonadIO m => IO a -> ExceptT IOException m a
tryIO :: forall (m :: * -> *) a.
MonadIO m =>
IO a -> ExceptT IOException m a
tryIO = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
Exception.try
handleExceptT :: (Exception e, Functor m, MonadCatch m) => (e -> x) -> m a -> ExceptT x m a
handleExceptT :: forall e (m :: * -> *) x a.
(Exception e, Functor m, MonadCatch m) =>
(e -> x) -> m a -> ExceptT x m a
handleExceptT e -> x
handler = forall (m :: * -> *) e f a b.
Functor m =>
(e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
bimapExceptT e -> x
handler forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try
syncIO :: MonadIO m => IO a -> ExceptT SomeException m a
syncIO :: forall (m :: * -> *) a.
MonadIO m =>
IO a -> ExceptT SomeException m a
syncIO = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either SomeException a)
trySync
trySync :: IO a -> IO (Either SomeException a)
trySync :: forall a. IO a -> IO (Either SomeException a)
trySync IO a
io = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right IO a
io) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exception.catch` \SomeException
e ->
case forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e of
Just (Exception.SomeAsyncException e
_) -> forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
e
Maybe SomeAsyncException
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left SomeException
e)