-- |
-- The identity monad transformer.
--
-- This is useful for functions parameterized by a monad transformer.
--
module Foundation.Monad.Identity
    ( IdentityT
    , runIdentityT
    ) where

import Basement.Compat.Base hiding (throw)
import Basement.Monad (MonadFailure(..))
import Foundation.Monad.MonadIO
import Foundation.Monad.Exception
import Foundation.Monad.Transformer

-- | Identity Transformer
newtype IdentityT m a = IdentityT { forall (m :: * -> *) a. IdentityT m a -> m a
runIdentityT :: m a }

instance Functor m => Functor (IdentityT m) where
    fmap :: forall a b. (a -> b) -> IdentityT m a -> IdentityT m b
fmap a -> b
f (IdentityT m a
m) = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m a
m)
    {-# INLINE fmap #-}

instance Applicative m => Applicative (IdentityT m) where
    pure :: forall a. a -> IdentityT m a
pure a
x = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
    {-# INLINE pure #-}
    IdentityT m (a -> b)
fab <*> :: forall a b. IdentityT m (a -> b) -> IdentityT m a -> IdentityT m b
<*> IdentityT m a
fa = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT (forall (m :: * -> *) a. IdentityT m a -> m a
runIdentityT IdentityT m (a -> b)
fab forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. IdentityT m a -> m a
runIdentityT IdentityT m a
fa)
    {-# INLINE (<*>) #-}

instance Monad m => Monad (IdentityT m) where
    return :: forall a. a -> IdentityT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}
    IdentityT m a
ma >>= :: forall a b. IdentityT m a -> (a -> IdentityT m b) -> IdentityT m b
>>= a -> IdentityT m b
mb = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. IdentityT m a -> m a
runIdentityT IdentityT m a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. IdentityT m a -> m a
runIdentityT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> IdentityT m b
mb
    {-# INLINE (>>=) #-}

instance MonadTrans IdentityT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> IdentityT m a
lift = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT
    {-# INLINE lift #-}

instance MonadIO m => MonadIO (IdentityT m) where
    liftIO :: forall a. IO a -> IdentityT m a
liftIO IO a
f = forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
f)
    {-# INLINE liftIO #-}

instance MonadFailure m => MonadFailure (IdentityT m) where
    type Failure (IdentityT m) = Failure m
    mFail :: Failure (IdentityT m) -> IdentityT m ()
mFail = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *). MonadFailure m => Failure m -> m ()
mFail

instance MonadThrow m => MonadThrow (IdentityT m) where
    throw :: forall e a. Exception e => e -> IdentityT m a
throw e
e = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw e
e)

instance MonadCatch m => MonadCatch (IdentityT m) where
    catch :: forall e a.
Exception e =>
IdentityT m a -> (e -> IdentityT m a) -> IdentityT m a
catch (IdentityT m a
m) e -> IdentityT m a
c = forall (m :: * -> *) a. m a -> IdentityT m a
IdentityT forall a b. (a -> b) -> a -> b
$ m a
m forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (forall (m :: * -> *) a. IdentityT m a -> m a
runIdentityT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> IdentityT m a
c)