{-# LANGUAGE CPP #-}#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}#endif
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE AutoDeriveTypeable #-}#endif
------------------------------------------------------------------------------- |-- Module : Control.Monad.Trans.Maybe-- Copyright : (c) 2007 Yitzak Gale, Eric Kidd-- License : BSD-style (see the file LICENSE)---- Maintainer : R.Paterson@city.ac.uk-- Stability : experimental-- Portability : portable---- The 'MaybeT' monad transformer extends a monad with the ability to exit-- the computation without returning a value.---- A sequence of actions produces a value only if all the actions in-- the sequence do. If one exits, the rest of the sequence is skipped-- and the composite action exits.---- For a variant allowing a range of exception values, see-- "Control.Monad.Trans.Except".-----------------------------------------------------------------------------moduleControl.Monad.Trans.Maybe(-- * The MaybeT monad transformerMaybeT (..),mapMaybeT ,-- * Monad transformationsmaybeToExceptT ,exceptToMaybeT ,-- * Lifting other operationsliftCallCC ,liftCatch ,liftListen ,liftPass ,)whereimportControl.Monad.IO.ClassimportControl.Monad.Signatures importControl.Monad.Trans.Class importControl.Monad.Trans.Except (ExceptT (..))importData.Functor.ClassesimportControl.ApplicativeimportControl.Monad(MonadPlus(mzero,mplus),liftM)#if MIN_VERSION_base(4,9,0)
importqualifiedControl.Monad.FailasFail#endif
importControl.Monad.Fix(MonadFix(mfix))#if MIN_VERSION_base(4,4,0)
importControl.Monad.Zip(MonadZip(mzipWith))#endif
importData.Foldable(Foldable(foldMap))importData.Maybe(fromMaybe)importData.Traversable(Traversable(traverse))-- | The parameterizable maybe monad, obtained by composing an arbitrary-- monad with the 'Maybe' monad.---- Computations are actions that may produce a value or exit.---- The 'return' function yields a computation that produces that-- value, while @>>=@ sequences two subcomputations, exiting if either-- computation does.newtypeMaybeT m a =MaybeT {runMaybeT ::m (Maybea )}instance(Eq1m )=>Eq1(MaybeT m )whereliftEq eq (MaybeT x )(MaybeT y )=liftEq(liftEqeq )x y {-# INLINEliftEq#-}instance(Ord1m )=>Ord1(MaybeT m )whereliftCompare comp (MaybeT x )(MaybeT y )=liftCompare(liftComparecomp )x y {-# INLINEliftCompare#-}instance(Read1m )=>Read1(MaybeT m )whereliftReadsPrec rp rl =readsData$readsUnaryWith(liftReadsPrecrp' rl' )"MaybeT"MaybeT whererp' =liftReadsPrecrp rl rl' =liftReadListrp rl instance(Show1m )=>Show1(MaybeT m )whereliftShowsPrec sp sl d (MaybeT m )=showsUnaryWith(liftShowsPrecsp' sl' )"MaybeT"d m wheresp' =liftShowsPrecsp sl sl' =liftShowListsp sl instance(Eq1m ,Eqa )=>Eq(MaybeT m a )where(== )=eq1instance(Ord1m ,Orda )=>Ord(MaybeT m a )wherecompare =compare1instance(Read1m ,Reada )=>Read(MaybeT m a )wherereadsPrec =readsPrec1instance(Show1m ,Showa )=>Show(MaybeT m a )whereshowsPrec =showsPrec1-- | Transform the computation inside a @MaybeT@.---- * @'runMaybeT' ('mapMaybeT' f m) = f ('runMaybeT' m)@mapMaybeT::(m (Maybea )->n (Maybeb ))->MaybeT m a ->MaybeT n b mapMaybeT f =MaybeT .f .runMaybeT{-# INLINEmapMaybeT#-}-- | Convert a 'MaybeT' computation to 'ExceptT', with a default-- exception value.maybeToExceptT::(Functorm )=>e ->MaybeT m a ->ExceptT e m a maybeToExceptT e (MaybeT m )=ExceptT $fmap(maybe(Lefte )Right)m {-# INLINEmaybeToExceptT#-}-- | Convert a 'ExceptT' computation to 'MaybeT', discarding the-- value of any exception.exceptToMaybeT::(Functorm )=>ExceptT e m a ->MaybeT m a exceptToMaybeT (ExceptT m )=MaybeT $fmap(either(constNothing)Just)m {-# INLINEexceptToMaybeT#-}instance(Functorm )=>Functor(MaybeT m )wherefmap f =mapMaybeT (fmap(fmapf )){-# INLINEfmap#-}instance(Foldablef )=>Foldable(MaybeT f )wherefoldMap f (MaybeT a )=foldMap(foldMapf )a {-# INLINEfoldMap#-}instance(Traversablef )=>Traversable(MaybeT f )wheretraverse f (MaybeT a )=MaybeT <$>traverse(traversef )a {-# INLINEtraverse#-}instance(Functorm ,Monadm )=>Applicative(MaybeT m )wherepure =MaybeT .return.Just{-# INLINEpure#-}mf <*> mx =MaybeT $domb_f <-runMaybeTmf casemb_f ofNothing->returnNothingJustf ->domb_x <-runMaybeTmx casemb_x ofNothing->returnNothingJustx ->return(Just(f x )){-# INLINE(<*>)#-}m *> k =m >>=\_->k {-# INLINE(*>)#-}instance(Functorm ,Monadm )=>Alternative(MaybeT m )whereempty =MaybeT (returnNothing){-# INLINEempty#-}x <|> y =MaybeT $dov <-runMaybeTx casev ofNothing->runMaybeTy Just_->returnv {-# INLINE(<|>)#-}instance(Monadm )=>Monad(MaybeT m )where#if !(MIN_VERSION_base(4,8,0))
return=MaybeT.return.Just{-# INLINEreturn#-}#endif
x >>= f =MaybeT $dov <-runMaybeTx casev ofNothing->returnNothingJusty ->runMaybeT(f y ){-# INLINE(>>=)#-}fail _=MaybeT (returnNothing){-# INLINEfail#-}#if MIN_VERSION_base(4,9,0)
instance(Monadm )=>Fail.MonadFail(MaybeT m )wherefail _=MaybeT (returnNothing){-# INLINEfail#-}#endif
instance(Monadm )=>MonadPlus(MaybeT m )wheremzero =MaybeT (returnNothing){-# INLINEmzero#-}mplus x y =MaybeT $dov <-runMaybeTx casev ofNothing->runMaybeTy Just_->returnv {-# INLINEmplus#-}instance(MonadFixm )=>MonadFix(MaybeT m )wheremfix f =MaybeT (mfix(runMaybeT.f .fromMaybebomb ))wherebomb =error"mfix (MaybeT): inner computation returned Nothing"{-# INLINEmfix#-}instanceMonadTrans MaybeT wherelift =MaybeT .liftMJust{-# INLINElift#-}instance(MonadIOm )=>MonadIO(MaybeT m )whereliftIO =lift .liftIO{-# INLINEliftIO#-}#if MIN_VERSION_base(4,4,0)
instance(MonadZipm )=>MonadZip(MaybeT m )wheremzipWith f (MaybeT a )(MaybeT b )=MaybeT $mzipWith(liftA2f )a b {-# INLINEmzipWith#-}#endif
-- | Lift a @callCC@ operation to the new monad.liftCallCC::CallCC m (Maybea )(Maybeb )->CallCC (MaybeT m )a b liftCallCC callCC f =MaybeT $callCC $\c ->runMaybeT(f (MaybeT .c .Just)){-# INLINEliftCallCC#-}-- | Lift a @catchE@ operation to the new monad.liftCatch::Catch e m (Maybea )->Catch e (MaybeT m )a liftCatch f m h =MaybeT $f (runMaybeTm )(runMaybeT.h ){-# INLINEliftCatch#-}-- | Lift a @listen@ operation to the new monad.liftListen::(Monadm )=>Listen w m (Maybea )->Listen w (MaybeT m )a liftListen listen =mapMaybeT $\m ->do(a ,w )<-listen m return$!fmap(\r ->(r ,w ))a {-# INLINEliftListen#-}-- | Lift a @pass@ operation to the new monad.liftPass::(Monadm )=>Pass w m (Maybea )->Pass w (MaybeT m )a liftPass pass =mapMaybeT $\m ->pass $doa <-m return$!casea ofNothing->(Nothing,id)Just(v ,f )->(Justv ,f ){-# INLINEliftPass#-}