{-# LANGUAGE TypeFamilies, NoMonomorphismRestriction, MultiParamTypeClasses, FlexibleInstances,
NoImplicitPrelude, FlexibleContexts #-}-- |This module provides alternatives to the 'Functor', 'Monad' and 'MonadPlus' classes,-- allowing for constraints on the contained type (a restricted monad).-- It makes use of associated datatypes (available in GHC 6.8).---- To make your own type instances of these classes, first define-- the 'Suitable' type class for it. For example,---- @-- instance Ord a => Suitable Set a where-- data Constraints Set a = Ord a => SetConstraints-- constraints _ = SetConstraints-- @---- You need to change @Set@ to your own type, @Ord a@ to your own-- constraints, and @SetConstraints@ to some distinguished name (this name-- will not normally be visible to users of your type)---- Next you can make an instance of 'RMonad' and if appropriate 'RMonadPlus'-- by defining the members in the usual way. When you need to make use of the-- constraint on the contained type, you will need to get hold of the constraint-- wrapped up in the 'Constraints' datatype. For example here are the instances-- for @Set@:---- @-- instance RMonad Set where-- return = Set.singleton-- s >>= f = let res = case constraints res of-- SetConstraints -> Set.fold (\a s' -> Set.union (f a) s') Set.empty s-- in res-- fail _ = Set.empty-- @---- @-- instance RMonadPlus Set where-- mzero = Set.empty-- mplus s1 s2 = let res = case constraints res of-- SetConstraints -> Set.union s1 s2-- in res-- @---- Once you have made your type an instance of 'RMonad', you can-- use it in two ways.-- Firstly, import this module directly and use the @NoImplicitPrelude@ extension-- so that do-syntax is rebound.-- Secondly, use the wrapper type in "Control.RMonad.AsMonad" which supports-- the normal 'Monad' operations.moduleControl.RMonad(Suitable(..),RFunctor(..),RMonad(..),RMonadPlus(..),(<=<),(=<<),(>=>),ap,filterM,foldM,foldM_,forM,forM_,forever,guard,join,liftM,liftM2,liftM3,liftM4,liftM5,mapAndUnzipM,mapM,mapM_,msum,replicateM,replicateM_,sequence,sequence_,unless,when,zipWithM,zipWithM_)whereimportPreludehiding(return,fail,(>>=),(>>),(=<<),mapM,mapM_,sequence,sequence_)importqualifiedControl.MonadasMimportData.Set(Set)importqualifiedData.SetasSetclassSuitablemawheredataConstraintsmaconstraints::ma->ConstraintsmaclassRFunctorfwherefmap::(Suitablefa,Suitablefb)=>(a->b)->fa->fbinfixl1>>=infixl1>>classRMonadmwherereturn::Suitablema=>a->ma(>>=)::(Suitablema,Suitablemb)=>ma->(a->mb)->mb(>>)::(Suitablema,Suitablemb)=>ma->mb->mbm1>>m2=m1>>=\_->m2fail::Suitablema=>String->mafail=errorclassRMonadm=>RMonadPlusmwheremzero::Suitablema=>mamplus::Suitablema=>ma->ma->mainstanceSuitable((->)r)awheredataConstraints((->)r)a=FuncConstraintsconstraints_=FuncConstraintsinstanceRFunctor((->)r)wherefmap=M.fmapinstanceRMonad((->)r)wherereturn=M.return(>>=)=(M.>>=)fail=M.failinstanceSuitableMaybeawheredataConstraintsMaybea=MaybeConstraintsconstraints_=MaybeConstraintsinstanceRFunctorMaybewherefmap=M.fmapinstanceRMonadMaybewherereturn=M.return(>>=)=(M.>>=)fail=M.failinstanceRMonadPlusMaybewheremzero=M.mzeromplus=M.mplusinstanceSuitable[]awheredataConstraints[]a=ListConstraintsconstraints_=ListConstraintsinstanceRFunctor[]wherefmap=M.fmapinstanceRMonad[]wherereturn=M.return(>>=)=(M.>>=)fail=M.failinstanceRMonadPlus[]wheremzero=M.mzeromplus=M.mplusinstanceSuitableIOawheredataConstraintsIOa=IOConstraintsconstraints_=IOConstraintsinstanceRFunctorIOwherefmap=M.fmapinstanceRMonadIOwherereturn=M.return(>>=)=(M.>>=)fail=M.failinstanceOrda=>SuitableSetawheredataConstraintsSeta=Orda=>SetConstraintsconstraints_=SetConstraintsinstanceRFunctorSetwherefmapfa=letres=case(constraintsa,constraintsres)of(SetConstraints,SetConstraints)->Set.mapfainresinstanceRMonadSetwhere{-# INLINE return #-}return=Set.singleton{-# INLINE (>>=) #-}s>>=f=letres=caseconstraintsresofSetConstraints->Set.fold(\as'->Set.union(fa)s')Set.emptysinres{-# INLINE fail #-}fail_=Set.emptyinstanceRMonadPlusSetwhere{-# INLINE mzero #-}mzero=Set.empty{-# INLINE mplus #-}mpluss1s2=letres=caseconstraintsresofSetConstraints->Set.unions1s2inresinfixr1<=<(<=<)::(RMonadm,Suitablema,Suitablemb,Suitablemc)=>(b->mc)->(a->mb)->a->mc(f<=<g)a=ga>>=finfixr1=<<(=<<)::(RMonadm,Suitablema,Suitablemb)=>(a->mb)->ma->mb(=<<)=flip(>>=)infixr1>=>(>=>)::(RMonadm,Suitablema,Suitablemb,Suitablemc)=>(a->mb)->(b->mc)->a->mc(>=>)=flip(<=<)ap::(RMonadm,Suitablem(a->b),Suitablema,Suitablemb)=>m(a->b)->ma->mbap=liftM2($)filterM::(RMonadm,Suitablem[a],SuitablemBool)=>(a->mBool)->[a]->m[a]filterM_[]=return[]filterMf(x:xs)=dob<-fxres<-filterMfxsreturn(ifbthenx:reselseres)foldM::(RMonadm,Suitablema)=>(a->b->ma)->a->[b]->mafoldM_a[]=returnafoldMfa(x:xs)=dofax<-faxfoldMffaxxsfoldM_::(RMonadm,Suitablema,Suitablem())=>(a->b->ma)->a->[b]->m()foldM_faxs=foldMfaxs>>return()forM::(RMonadm,Suitablemb,Suitablem[b])=>[a]->(a->mb)->m[b]forM=flipmapMforM_::(RMonadm,Suitablemb,Suitablem())=>[a]->(a->mb)->m()forM_=flipmapM_forever::(RMonadm,Suitablema,Suitablemb)=>ma->mbforeverma=letmb=ma>>mbinmbguard::(RMonadPlusm,Suitablem())=>Bool->m()guardTrue=return()guardFalse=mzerojoin::(RMonadm,Suitablema,Suitablem(ma))=>m(ma)->majoinmma=mma>>=idliftM::(RMonadm,Suitablema1,Suitablemr)=>(a1->r)->ma1->mrliftMfma1=do{a1<-ma1;return(fa1)}liftM2::(RMonadm,Suitablema1,Suitablema2,Suitablemr)=>(a1->a2->r)->ma1->ma2->mrliftM2fma1ma2=do{a1<-ma1;a2<-ma2;return(fa1a2)}liftM3::(RMonadm,Suitablema1,Suitablema2,Suitablema3,Suitablemr)=>(a1->a2->a3->r)->ma1->ma2->ma3->mrliftM3fma1ma2ma3=do{a1<-ma1;a2<-ma2;a3<-ma3;return(fa1a2a3)}liftM4::(RMonadm,Suitablema1,Suitablema2,Suitablema3,Suitablema4,Suitablemr)=>(a1->a2->a3->a4->r)->ma1->ma2->ma3->ma4->mrliftM4fma1ma2ma3ma4=do{a1<-ma1;a2<-ma2;a3<-ma3;a4<-ma4;return(fa1a2a3a4)}liftM5::(RMonadm,Suitablema1,Suitablema2,Suitablema3,Suitablema4,Suitablema5,Suitablemr)=>(a1->a2->a3->a4->a5->r)->ma1->ma2->ma3->ma4->ma5->mrliftM5fma1ma2ma3ma4ma5=do{a1<-ma1;a2<-ma2;a3<-ma3;a4<-ma4;a5<-ma5;return(fa1a2a3a4a5)}mapAndUnzipM::(RMonadm,Suitablem(b,c),Suitablem[(b,c)],Suitablem([b],[c]))=>(a->m(b,c))->[a]->m([b],[c])mapAndUnzipMfxs=liftMunzip(mapMfxs)mapM::(RMonadm,Suitablemb,Suitablem[b])=>(a->mb)->[a]->m[b]mapMfxs=sequence(mapfxs)mapM_::(RMonadm,Suitablemb,Suitablem())=>(a->mb)->[a]->m()mapM_fxs=sequence_(mapfxs)msum::(RMonadPlusm,Suitablema)=>[ma]->mamsum=foldrmplusmzeroreplicateM::(RMonadm,Suitablema,Suitablem[a])=>Int->ma->m[a]replicateMnma=sequence(replicatenma)replicateM_::(RMonadm,Suitablema,Suitablem())=>Int->ma->m()replicateM_nma=sequence_(replicatenma)sequence::(RMonadm,Suitablema,Suitablem[a])=>[ma]->m[a]sequence[]=return[]sequence(ma:mas)=liftM2(:)ma(sequencemas)sequence_::(RMonadm,Suitablema,Suitablem())=>[ma]->m()sequence_[]=return()sequence_(ma:mas)=ma>>sequence_masunless::(RMonadm,Suitablem())=>Bool->m()->m()unlessTruem=return()unlessFalsem=mwhen::(RMonadm,Suitablem())=>Bool->m()->m()whenTruem=mwhenFalsem=return()zipWithM::(RMonadm,Suitablemc,Suitablem[c])=>(a->b->mc)->[a]->[b]->m[c]zipWithMfasbs=sequence(zipWithfasbs)zipWithM_::(RMonadm,Suitablemc,Suitablem())=>(a->b->mc)->[a]->[b]->m()zipWithM_fasbs=sequence_(zipWithfasbs)