# ListT done right alternative

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

The following is an alternative implementation for ListT done right. You will find a similar implementation in the "list-t" package.

```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)
```