module Control.Monad.Sequence
(
SeqT (..)
)
where
import Control.Applicative
import Control.Monad hiding (mapM, msum)
import Control.Monad.Trans
import Data.Foldable
import Data.Monoid
import Data.Sequence
import Data.Traversable
import Prelude hiding (mapM)
instance Applicative Seq where
pure = return
(<*>) = ap
instance Alternative Seq where
empty = mzero
(<|>) = mplus
newtype SeqT m a = SeqT { runSeqT :: m (Seq a) }
mapSeqT :: (m (Seq a) -> n (Seq b)) -> SeqT m a -> SeqT n b
mapSeqT f = SeqT . f . runSeqT
instance Functor m => Functor (SeqT m) where
fmap = mapSeqT . fmap . fmap
instance Applicative m => Applicative (SeqT m) where
pure = SeqT . pure . return
a <*> b = SeqT (ap <$> runSeqT a <*> runSeqT b)
instance Applicative m => Alternative (SeqT m) where
empty = SeqT (pure mempty)
a <|> b = SeqT (mappend <$> runSeqT a <*> runSeqT b)
instance Monad m => Monad (SeqT m) where
return = SeqT . return . return
m >>= k = SeqT $
do a <- runSeqT m
b <- mapM (runSeqT . k) a
return (msum b)
fail _ = SeqT (return mempty)
instance Monad m => MonadPlus (SeqT m) where
mzero = SeqT (return mempty)
m `mplus` n = SeqT (liftM2 mappend (runSeqT m) (runSeqT n))
instance MonadTrans SeqT where
lift m = SeqT (liftM return m)
instance MonadIO m => MonadIO (SeqT m) where
liftIO = lift . liftIO