module Control.Monad.Trans.Identity (
IdentityT(..),
mapIdentityT,
liftCatch,
liftCallCC,
) where
import Control.Applicative
import Control.Monad (MonadPlus(mzero, mplus))
import Control.Monad.Fix (MonadFix(mfix))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Data.Foldable (Foldable(foldMap))
import Data.Traversable (Traversable(traverse))
newtype IdentityT m a = IdentityT { runIdentityT :: m a }
instance (Functor m) => Functor (IdentityT m) where
fmap f = mapIdentityT (fmap f)
instance (Foldable f) => Foldable (IdentityT f) where
foldMap f (IdentityT a) = foldMap f a
instance (Traversable f) => Traversable (IdentityT f) where
traverse f (IdentityT a) = IdentityT <$> traverse f a
instance (Applicative m) => Applicative (IdentityT m) where
pure x = IdentityT (pure x)
(<*>) = lift2IdentityT (<*>)
instance (Alternative m) => Alternative (IdentityT m) where
empty = IdentityT empty
(<|>) = lift2IdentityT (<|>)
instance (Monad m) => Monad (IdentityT m) where
return = IdentityT . return
m >>= k = IdentityT $ runIdentityT . k =<< runIdentityT m
fail msg = IdentityT $ fail msg
instance (MonadPlus m) => MonadPlus (IdentityT m) where
mzero = IdentityT mzero
mplus = lift2IdentityT mplus
instance (MonadFix m) => MonadFix (IdentityT m) where
mfix f = IdentityT (mfix (runIdentityT . f))
instance (MonadIO m) => MonadIO (IdentityT m) where
liftIO = IdentityT . liftIO
instance MonadTrans IdentityT where
lift = IdentityT
mapIdentityT :: (m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT f = IdentityT . f . runIdentityT
lift2IdentityT ::
(m a -> n b -> p c) -> IdentityT m a -> IdentityT n b -> IdentityT p c
lift2IdentityT f a b = IdentityT (f (runIdentityT a) (runIdentityT b))
liftCallCC :: (((a -> m b) -> m a) ->
m a) -> ((a -> IdentityT m b) -> IdentityT m a) -> IdentityT m a
liftCallCC callCC f =
IdentityT $ callCC $ \ c -> runIdentityT (f (IdentityT . c))
liftCatch :: (m a -> (e -> m a) -> m a) ->
IdentityT m a -> (e -> IdentityT m a) -> IdentityT m a
liftCatch f m h = IdentityT $ f (runIdentityT m) (runIdentityT . h)