{-# LANGUAGE CPP #-}

-- | This module exports miscellaneous error-handling functions.

module Control.Error.Util (
    -- * Conversion
    -- $conversion
    hush,
    hushT,
    note,
    noteT,
    hoistMaybe,
    hoistEither,
    (??),
    (!?),
    failWith,
    failWithM,

    -- * Bool
    bool,

    -- * Maybe
    (?:),

    -- * MaybeT
    maybeT,
    just,
    nothing,
    isJustT,
    isNothingT,

    -- * Either
    isLeft,
    isRight,
    fmapR,
    AllE(..),
    AnyE(..),

    -- * ExceptT
    isLeftT,
    isRightT,
    fmapRT,
    exceptT,
    bimapExceptT,

    -- * Error Reporting
    err,
    errLn,

    -- * Exceptions
    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

-- | Fold an 'ExceptT' by providing one continuation for each constructor
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 #-}

-- | Transform the left and right value
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 #-}

-- | Upgrade an 'Either' to an 'ExceptT'
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 #-}

{- $conversion
    Use these functions to convert between 'Maybe', 'Either', 'MaybeT', and
    'ExceptT'.
-}
-- | Suppress the 'Left' value of an 'Either'
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

-- | Suppress the 'Left' value of an 'ExceptT'
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

-- | Tag the 'Nothing' value of a 'Maybe'
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

-- | Tag the 'Nothing' value of a 'MaybeT'
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

-- | Lift a 'Maybe' to the 'MaybeT' monad
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

-- | Convert a 'Maybe' value into the 'ExceptT' monad
(??) :: 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)

-- | Convert an applicative 'Maybe' value into the 'ExceptT' monad
(!?) :: 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)

-- | An infix form of 'fromMaybe' with arguments flipped.
(?:) :: 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 ?:

{-| Convert a 'Maybe' value into the 'ExceptT' monad

    Named version of ('??') with arguments flipped
-}
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

{- | Convert an applicative 'Maybe' value into the 'ExceptT' monad

    Named version of ('!?') with arguments flipped
-}
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

{- | Case analysis for the 'Bool' type.

   > bool a b c == if c then b else a
-}
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 #-}

{-| Case analysis for 'MaybeT'

    Use the first argument if the 'MaybeT' computation fails, otherwise apply
    the function to the successful result.
-}
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

-- | Analogous to 'Just' and equivalent to 'return'
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))

-- | Analogous to 'Nothing' and equivalent to 'mzero'
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)

-- | Analogous to 'Data.Maybe.isJust', but for 'MaybeT'
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 #-}

-- | Analogous to 'Data.Maybe.isNothing', but for 'MaybeT'
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 #-}

-- | Returns whether argument is a 'Left'
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)

-- | Returns whether argument is a 'Right'
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)

{- | 'fmap' specialized to 'Either', given a name symmetric to
     'Data.EitherR.fmapL'
-}
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

{-| Run multiple 'Either' computations and succeed if all of them succeed

    'mappend's all successes or failures
-}
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

{-| Run multiple 'Either' computations and succeed if any of them succeed

    'mappend's all successes or failures
-}
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

-- | Analogous to 'isLeft', but for 'ExceptT'
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 #-}

-- | Analogous to 'isRight', but for 'ExceptT'
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 #-}

{- | 'fmap' specialized to 'ExceptT', given a name symmetric to
     'Data.EitherR.fmapLT'
-}
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

-- | Write a string to standard error
err :: Text -> IO ()
err :: Text -> IO ()
err = Handle -> Text -> IO ()
Data.Text.IO.hPutStr Handle
stderr

-- | Write a string with a newline to standard error
errLn :: Text -> IO ()
errLn :: Text -> IO ()
errLn = Handle -> Text -> IO ()
Data.Text.IO.hPutStrLn Handle
stderr

-- | Catch 'IOException's and convert them to the 'ExceptT' monad
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

-- | Run a monad action which may throw an exception in the `ExceptT` monad
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


{-| Catch all exceptions, except for asynchronous exceptions found in @base@
    and convert them to the 'ExceptT' monad
-}
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)