ListT done right alternative
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
The following is an alternative implementation for ListT done right:
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Error
import Control.Monad.Cont
import Control.Arrow
newtype ListT m a = ListT { runListT :: m (Maybe (a, ListT m a)) }
foldListT :: Monad m => (a -> m b -> m b) -> m b -> ListT m a -> m b
foldListT c n (ListT m) = maybe n (\(x,l) -> c x (foldListT c n l)) =<< m
-- In ListT from Control.Monad this one is the data constructor ListT, so sadly, this code can't be a drop-in replacement.
liftList :: Monad m => [a] -> ListT m a
liftList [] = ListT $ return Nothing
liftList (x:xs) = ListT . return $ Just (x, liftList xs)
instance Functor m => Functor (ListT m) where
fmap f (ListT m) = ListT $ fmap (fmap $ f *** fmap f) m where
instance (Monad m) => Monad (ListT m) where
return x = ListT . return $ Just (x, mzero)
m >>= f = ListT $
foldListT (\x l -> runListT $ f x `mplus` ListT l) (return Nothing) m
instance MonadTrans ListT where
lift = ListT . liftM (\x -> Just (x, mzero))
instance Monad m => MonadPlus (ListT m) where
mzero = ListT $ return Nothing
ListT m1 `mplus` ListT m2 = ListT $
maybe m2 (return . Just . second (`mplus` ListT m2)) =<< m1
-- These things typecheck, but I haven't made sure what they do is sensible.
instance (MonadIO m, Functor m) => MonadIO (ListT m) where
liftIO = lift . liftIO
instance (MonadReader s m, Functor m) => MonadReader s (ListT m) where
ask = lift ask
local f = ListT . local f . runListT
instance (MonadState s m, Functor m) => MonadState s (ListT m) where
get = lift get
put = lift . put
instance MonadCont m => MonadCont (ListT m) where
callCC f = ListT $
callCC $ \c -> runListT . f $ \a ->
ListT . c $ Just (a, ListT $ return Nothing)
instance (MonadError e m) => MonadError e (ListT m) where
throwError = lift . throwError
-- I can't really decide between those two possible implementations.
-- The first one is more like the IO monad works, the second one catches
-- all possible errors in the list.
-- ListT m `catchError` h = ListT $ m `catchError` \e -> runListT (h e)
(m :: ListT m a) `catchError` h = deepCatch m where
deepCatch :: ListT m a -> ListT m a
deepCatch (ListT xs) = ListT $ liftM (fmap $ second deepCatch) xs
`catchError` \e -> runListT (h e)