module Control.Monad.DList (
DListT (..), toListT, joinDListT
) where
import Control.Applicative (Applicative(..))
import Control.Monad (MonadPlus(..), liftM, ap)
import Control.Monad.ListT (ListT)
import Control.Monad.Trans (MonadTrans(..))
import Data.List.Class (List(..), cons)
import Data.Monoid (Monoid(..))
newtype DListT m a = DListT { runDListT :: ListT m a -> ListT m a }
toListT :: Monad m => DListT m a -> ListT m a
toListT = (`runDListT` mzero)
joinDListT :: Monad m => m (DListT m a) -> DListT m a
joinDListT action =
DListT (joinL . (`liftM` action) . flip runDListT)
instance Monoid (DListT l a) where
mempty = DListT id
mappend (DListT a) (DListT b) = DListT $ a . b
instance Monad m => Functor (DListT m) where
fmap func = DListT . mplus . liftM func . toListT
instance Monad m => Monad (DListT m) where
return = DListT . cons
a >>= b = DListT . mplus $ toListT a >>= liftM toListT b
instance Monad m => Applicative (DListT m) where
pure = return
(<*>) = ap
instance Monad m => MonadPlus (DListT m) where
mzero = mempty
mplus = mappend
instance MonadTrans DListT where
lift = DListT . mappend . lift