{-# LANGUAGE CPP #-}#if __GLASGOW_HASKELL__ >= 702{-# LANGUAGE Safe #-}#endif#if __GLASGOW_HASKELL__ >= 706{-# LANGUAGE PolyKinds #-}#endif#if __GLASGOW_HASKELL__ >= 710{-# LANGUAGE AutoDeriveTypeable #-}#endif------------------------------------------------------------------------------- |-- Module : Control.Monad.Trans.Identity-- Copyright : (c) 2007 Magnus Therning-- License : BSD-style (see the file LICENSE)---- Maintainer : R.Paterson@city.ac.uk-- Stability : experimental-- Portability : portable---- The identity monad transformer.---- This is useful for functions parameterized by a monad transformer.-----------------------------------------------------------------------------moduleControl.Monad.Trans.Identity(-- * The identity monad transformerIdentityT (..),mapIdentityT ,-- * Lifting other operationsliftCatch ,liftCallCC ,)whereimportControl.Monad.IO.Class(MonadIO(liftIO))importControl.Monad.Signatures importControl.Monad.Trans.Class (MonadTrans (lift ))importData.Functor.ClassesimportControl.ApplicativeimportControl.Monad(MonadPlus(mzero,mplus))#if MIN_VERSION_base(4,9,0)importqualifiedControl.Monad.FailasFail#endifimportControl.Monad.Fix(MonadFix(mfix))#if MIN_VERSION_base(4,4,0)importControl.Monad.Zip(MonadZip(mzipWith))#endifimportData.Foldable(Foldable(foldMap))importData.Traversable(Traversable(traverse))-- | The trivial monad transformer, which maps a monad to an equivalent monad.newtypeIdentityT f a =IdentityT {runIdentityT ::f a }instance(Eq1f )=>Eq1(IdentityT f )whereliftEq eq (IdentityT x )(IdentityT y )=liftEqeq x y {-# INLINE liftEq #-}instance(Ord1f )=>Ord1(IdentityT f )whereliftCompare comp (IdentityT x )(IdentityT y )=liftComparecomp x y {-# INLINE liftCompare #-}instance(Read1f )=>Read1(IdentityT f )whereliftReadsPrec rp rl =readsData$readsUnaryWith(liftReadsPrecrp rl )"IdentityT"IdentityT instance(Show1f )=>Show1(IdentityT f )whereliftShowsPrec sp sl d (IdentityT m )=showsUnaryWith(liftShowsPrecsp sl )"IdentityT"d m instance(Eq1f ,Eqa )=>Eq(IdentityT f a )where(== )=eq1instance(Ord1f ,Orda )=>Ord(IdentityT f a )wherecompare =compare1instance(Read1f ,Reada )=>Read(IdentityT f a )wherereadsPrec =readsPrec1instance(Show1f ,Showa )=>Show(IdentityT f a )whereshowsPrec =showsPrec1instance(Functorm )=>Functor(IdentityT m )wherefmap f =mapIdentityT (fmapf ){-# INLINE fmap #-}instance(Foldablef )=>Foldable(IdentityT f )wherefoldMap f (IdentityT a )=foldMapf a {-# INLINE foldMap #-}instance(Traversablef )=>Traversable(IdentityT f )wheretraverse f (IdentityT a )=IdentityT <$>traversef a {-# INLINE traverse #-}instance(Applicativem )=>Applicative(IdentityT m )wherepure x =IdentityT (purex ){-# INLINE pure #-}(<*> )=lift2IdentityT (<*>){-# INLINE (<*>) #-}instance(Alternativem )=>Alternative(IdentityT m )whereempty =IdentityT empty{-# INLINE empty #-}(<|> )=lift2IdentityT (<|>){-# INLINE (<|>) #-}instance(Monadm )=>Monad(IdentityT m )where#if !(MIN_VERSION_base(4,8,0))return=IdentityT.return{-# INLINE return #-}#endifm >>= k =IdentityT $runIdentityT.k =<<runIdentityTm {-# INLINE (>>=) #-}fail msg =IdentityT $failmsg {-# INLINE fail #-}#if MIN_VERSION_base(4,9,0)instance(Fail.MonadFailm )=>Fail.MonadFail(IdentityT m )wherefail msg =IdentityT $Fail.failmsg {-# INLINE fail #-}#endifinstance(MonadPlusm )=>MonadPlus(IdentityT m )wheremzero =IdentityT mzero{-# INLINE mzero #-}mplus =lift2IdentityT mplus{-# INLINE mplus #-}instance(MonadFixm )=>MonadFix(IdentityT m )wheremfix f =IdentityT (mfix(runIdentityT.f )){-# INLINE mfix #-}instance(MonadIOm )=>MonadIO(IdentityT m )whereliftIO =IdentityT .liftIO{-# INLINE liftIO #-}#if MIN_VERSION_base(4,4,0)instance(MonadZipm )=>MonadZip(IdentityT m )wheremzipWith f =lift2IdentityT (mzipWithf ){-# INLINE mzipWith #-}#endifinstanceMonadTrans IdentityT wherelift =IdentityT {-# INLINE lift #-}-- | Lift a unary operation to the new monad.mapIdentityT::(m a ->n b )->IdentityT m a ->IdentityT n b mapIdentityT f =IdentityT .f .runIdentityT{-# INLINE mapIdentityT #-}-- | Lift a binary operation to the new monad.lift2IdentityT::(m a ->n b ->p c )->IdentityT m a ->IdentityT n b ->IdentityT p c lift2IdentityT f a b =IdentityT (f (runIdentityTa )(runIdentityTb )){-# INLINE lift2IdentityT #-}-- | Lift a @callCC@ operation to the new monad.liftCallCC::CallCC m a b ->CallCC (IdentityT m )a b liftCallCC callCC f =IdentityT $callCC $\c ->runIdentityT(f (IdentityT .c )){-# INLINE liftCallCC #-}-- | Lift a @catchE@ operation to the new monad.liftCatch::Catch e m a ->Catch e (IdentityT m )a liftCatch f m h =IdentityT $f (runIdentityTm )(runIdentityT.h ){-# INLINE liftCatch #-}