{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP, NoImplicitPrelude #-}------------------------------------------------------------------------------- |-- Module : Control.Monad-- Copyright : (c) The University of Glasgow 2001-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Stability : provisional-- Portability : portable---- The 'Functor', 'Monad' and 'MonadPlus' classes,-- with some useful operations on monads.moduleControl.Monad(-- * Functor and monad classesFunctor(fmap),Monad((>>=),(>>),return,fail),MonadPlus(-- class context: Monadmzero-- :: (MonadPlus m) => m a,mplus-- :: (MonadPlus m) => m a -> m a -> m a)-- * Functions-- ** Naming conventions-- $naming-- ** Basic @Monad@ functions,mapM-- :: (Monad m) => (a -> m b) -> [a] -> m [b],mapM_-- :: (Monad m) => (a -> m b) -> [a] -> m (),forM-- :: (Monad m) => [a] -> (a -> m b) -> m [b],forM_-- :: (Monad m) => [a] -> (a -> m b) -> m (),sequence-- :: (Monad m) => [m a] -> m [a],sequence_-- :: (Monad m) => [m a] -> m (),(=<<)-- :: (Monad m) => (a -> m b) -> m a -> m b,(>=>)-- :: (Monad m) => (a -> m b) -> (b -> m c) -> (a -> m c),(<=<)-- :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c),forever-- :: (Monad m) => m a -> m b,void-- ** Generalisations of list functions,join-- :: (Monad m) => m (m a) -> m a,msum-- :: (MonadPlus m) => [m a] -> m a,mfilter-- :: (MonadPlus m) => (a -> Bool) -> m a -> m a,filterM-- :: (Monad m) => (a -> m Bool) -> [a] -> m [a],mapAndUnzipM-- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c]),zipWithM-- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c],zipWithM_-- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m (),foldM-- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a,foldM_-- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m (),replicateM-- :: (Monad m) => Int -> m a -> m [a],replicateM_-- :: (Monad m) => Int -> m a -> m ()-- ** Conditional execution of monadic expressions,guard-- :: (MonadPlus m) => Bool -> m (),when-- :: (Monad m) => Bool -> m () -> m (),unless-- :: (Monad m) => Bool -> m () -> m ()-- ** Monadic lifting operators,liftM-- :: (Monad m) => (a -> b) -> (m a -> m b),liftM2-- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c),liftM3-- :: ...,liftM4-- :: ...,liftM5-- :: ...,ap-- :: (Monad m) => m (a -> b) -> m a -> m b)whereimportData.Maybe#ifdef __GLASGOW_HASKELL__importGHC.ListimportGHC.Base#endif#ifdef __GLASGOW_HASKELL__infixr1=<<-- ------------------------------------------------------------------------------- Prelude monad functions-- | Same as '>>=', but with the arguments interchanged.{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}(=<<)::Monadm=>(a->mb)->ma->mbf=<<x=x>>=f-- | Evaluate each action in the sequence from left to right,-- and collect the results.sequence::Monadm=>[ma]->m[a]{-# INLINE sequence #-}sequencems=foldrk(return[])mswherekmm'=do{x<-m;xs<-m';return(x:xs)}-- | Evaluate each action in the sequence from left to right,-- and ignore the results.sequence_::Monadm=>[ma]->m(){-# INLINE sequence_ #-}sequence_ms=foldr(>>)(return())ms-- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@.mapM::Monadm=>(a->mb)->[a]->m[b]{-# INLINE mapM #-}mapMfas=sequence(mapfas)-- | @'mapM_' f@ is equivalent to @'sequence_' . 'map' f@.mapM_::Monadm=>(a->mb)->[a]->m(){-# INLINE mapM_ #-}mapM_fas=sequence_(mapfas)#endif /* __GLASGOW_HASKELL__ */-- ------------------------------------------------------------------------------- The MonadPlus class definition-- | Monads that also support choice and failure.classMonadm=>MonadPlusmwhere-- | the identity of 'mplus'. It should also satisfy the equations---- > mzero >>= f = mzero-- > v >> mzero = mzero--mzero::ma-- | an associative operationmplus::ma->ma->mainstanceMonadPlus[]wheremzero=[]mplus=(++)instanceMonadPlusMaybewheremzero=NothingNothing`mplus`ys=ysxs`mplus`_ys=xs-- ------------------------------------------------------------------------------- Functions mandated by the Prelude-- | @'guard' b@ is @'return' ()@ if @b@ is 'True',-- and 'mzero' if @b@ is 'False'.guard::(MonadPlusm)=>Bool->m()guardTrue=return()guardFalse=mzero-- | This generalizes the list-based 'filter' function.filterM::(Monadm)=>(a->mBool)->[a]->m[a]filterM_[]=return[]filterMp(x:xs)=doflg<-pxys<-filterMpxsreturn(ifflgthenx:yselseys)-- | 'forM' is 'mapM' with its arguments flippedforM::Monadm=>[a]->(a->mb)->m[b]{-# INLINE forM #-}forM=flipmapM-- | 'forM_' is 'mapM_' with its arguments flippedforM_::Monadm=>[a]->(a->mb)->m(){-# INLINE forM_ #-}forM_=flipmapM_-- | This generalizes the list-based 'concat' function.msum::MonadPlusm=>[ma]->ma{-# INLINE msum #-}msum=foldrmplusmzeroinfixr1<=<,>=>-- | Left-to-right Kleisli composition of monads.(>=>)::Monadm=>(a->mb)->(b->mc)->(a->mc)f>=>g=\x->fx>>=g-- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped(<=<)::Monadm=>(b->mc)->(a->mb)->(a->mc)(<=<)=flip(>=>)-- | @'forever' act@ repeats the action infinitely.forever::(Monadm)=>ma->mb{-# INLINABLE forever #-}-- See Note [Make forever INLINABLE]forevera=a>>forevera{- Note [Make forever INLINABLE]If you say x = forever ayou'll get x = a >> a >> a >> a >> ... etc ...and that can make a massive space leak (see Trac #5205)In some monads, where (>>) is expensive, this might be the rightthing, but not in the IO monad. We want to specialise 'forever' forthe IO monad, so that eta expansion happens and there's no space leak.To achieve this we must make forever INLINABLE, so that it'll getspecialised at call sites.Still delicate, though, because it depends on optimisation. But therereally is a space/time tradeoff here, and only optimisation revealsthe "right" answer.-}-- | @'void' value@ discards or ignores the result of evaluation, such as the return value of an 'IO' action.void::Functorf=>fa->f()void=fmap(const())-- ------------------------------------------------------------------------------- Other monad functions-- | The 'join' function is the conventional monad join operator. It is used to-- remove one level of monadic structure, projecting its bound argument into the-- outer level.join::(Monadm)=>m(ma)->majoinx=x>>=id-- | The 'mapAndUnzipM' function maps its first argument over a list, returning-- the result as a pair of lists. This function is mainly used with complicated-- data structures or a state-transforming monad.mapAndUnzipM::(Monadm)=>(a->m(b,c))->[a]->m([b],[c])mapAndUnzipMfxs=sequence(mapfxs)>>=return.unzip-- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads.zipWithM::(Monadm)=>(a->b->mc)->[a]->[b]->m[c]zipWithMfxsys=sequence(zipWithfxsys)-- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.zipWithM_::(Monadm)=>(a->b->mc)->[a]->[b]->m()zipWithM_fxsys=sequence_(zipWithfxsys){- | The 'foldM' function is analogous to 'foldl', except that its result isencapsulated in a monad. Note that 'foldM' works from left-to-right overthe list arguments. This could be an issue where @('>>')@ and the `foldedfunction' are not commutative.> foldM f a1 [x1, x2, ..., xm]==> do> a2 <- f a1 x1> a3 <- f a2 x2> ...> f am xmIf right-to-left evaluation is required, the input list should be reversed.-}foldM::(Monadm)=>(a->b->ma)->a->[b]->mafoldM_a[]=returnafoldMfa(x:xs)=fax>>=\fax->foldMffaxxs-- | Like 'foldM', but discards the result.foldM_::(Monadm)=>(a->b->ma)->a->[b]->m()foldM_faxs=foldMfaxs>>return()-- | @'replicateM' n act@ performs the action @n@ times,-- gathering the results.replicateM::(Monadm)=>Int->ma->m[a]replicateMnx=sequence(replicatenx)-- | Like 'replicateM', but discards the result.replicateM_::(Monadm)=>Int->ma->m()replicateM_nx=sequence_(replicatenx){- | Conditional execution of monadic expressions. For example,> when debug (putStr "Debugging\n")will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True',and otherwise do nothing.-}when::(Monadm)=>Bool->m()->m()whenps=ifpthenselsereturn()-- | The reverse of 'when'.unless::(Monadm)=>Bool->m()->m()unlessps=ifpthenreturn()elses-- | Promote a function to a monad.liftM::(Monadm)=>(a1->r)->ma1->mrliftMfm1=do{x1<-m1;return(fx1)}-- | Promote a function to a monad, scanning the monadic arguments from-- left to right. For example,---- > liftM2 (+) [0,1] [0,2] = [0,2,1,3]-- > liftM2 (+) (Just 1) Nothing = Nothing--liftM2::(Monadm)=>(a1->a2->r)->ma1->ma2->mrliftM2fm1m2=do{x1<-m1;x2<-m2;return(fx1x2)}-- | Promote a function to a monad, scanning the monadic arguments from-- left to right (cf. 'liftM2').liftM3::(Monadm)=>(a1->a2->a3->r)->ma1->ma2->ma3->mrliftM3fm1m2m3=do{x1<-m1;x2<-m2;x3<-m3;return(fx1x2x3)}-- | Promote a function to a monad, scanning the monadic arguments from-- left to right (cf. 'liftM2').liftM4::(Monadm)=>(a1->a2->a3->a4->r)->ma1->ma2->ma3->ma4->mrliftM4fm1m2m3m4=do{x1<-m1;x2<-m2;x3<-m3;x4<-m4;return(fx1x2x3x4)}-- | Promote a function to a monad, scanning the monadic arguments from-- left to right (cf. 'liftM2').liftM5::(Monadm)=>(a1->a2->a3->a4->a5->r)->ma1->ma2->ma3->ma4->ma5->mrliftM5fm1m2m3m4m5=do{x1<-m1;x2<-m2;x3<-m3;x4<-m4;x5<-m5;return(fx1x2x3x4x5)}{- | In many situations, the 'liftM' operations can be replaced by uses of'ap', which promotes function application.> return f `ap` x1 `ap` ... `ap` xnis equivalent to> liftMn f x1 x2 ... xn-}ap::(Monadm)=>m(a->b)->ma->mbap=liftM2id-- ------------------------------------------------------------------------------- Other MonadPlus functions-- | Direct 'MonadPlus' equivalent of 'filter'-- @'filter'@ = @(mfilter:: (a -> Bool) -> [a] -> [a]@-- applicable to any 'MonadPlus', for example-- @mfilter odd (Just 1) == Just 1@-- @mfilter odd (Just 2) == Nothing@mfilter::(MonadPlusm)=>(a->Bool)->ma->mamfilterpma=doa<-maifpathenreturnaelsemzero{- $namingThe functions in this library use the following naming conventions:* A postfix \'@M@\' always stands for a function in the Kleisli category: The monad type constructor @m@ is added to function results (modulo currying) and nowhere else. So, for example,> filter :: (a -> Bool) -> [a] -> [a]> filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]* A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@. Thus, for example:> sequence :: Monad m => [m a] -> m [a]> sequence_ :: Monad m => [m a] -> m ()* A prefix \'@m@\' generalizes an existing function to a monadic form. Thus, for example:> sum :: Num a => [a] -> a> msum :: MonadPlus m => [m a] -> m a-}