[Haskell-cafe] Monad transformers [Stacking monads]

[David Menendez]

On Mon, Oct 6, 2008 at 4:48 PM, Andrew Coppin
<andrewcoppin at btinternet.com> wrote:
> Andrew Coppin wrote:
>>
>> I have some longwinded code that works, but I'm still thinking about how
>> to do this more elegantly. It looks like what I really need is something
>> like
>>
>>  type M = StateT State (ResultSetT (ErrorT ErrorType Identity))
>>
>> Is that the correct ordering?

Pretty much.

> For reference, I humbly present ResultSet.hs:

There are actually several ways to make ResultSetT from ResultSet,
depending on how you want to handle the inner monad. There are two
popular ways to make a transformer variant of [], of which the easier
looks something like this:

newtype ListT m a = ListT { unListT :: m (Stream m a) }
data Stream m a = Nil | Cons a (m (Stream m a))

Using that and your code as a pattern, I've come up with the guts of a
similar transformer, included below. Like your code, it maintains a
list of answers at each depth. The effects of each depth are deferred
until some code (e.g., to_list) demands it, but the effects associated
with any answer at a given depth are linked. The resulting code, I
imagine, is not very efficient, but it shouldn't be too awful. I've
tried to keep things structurally similar to your code, to hopefully
make it clearer what is happening.

I also recommend trying alternatives like Oleg's FBackTrackT. In that
code, "mplus" corresponds to "union".

<http://okmij.org/ftp/Haskell/FBackTrackT.hs>

====

import Control.Monad

newtype ResultSetT m a = Pack { unpack :: m (Stream m a) }

data Stream m a = Nil | Cons [a] (m (Stream m a))

-- this is just the important parts, the rest should be fairly straightforward.

raw_lift :: (Monad m) => m a -> m (Stream m a)
raw_lift = liftM (\x -> Cons [x] (return Nil))

raw_union :: (Monad m) => Stream m a -> Stream m a -> Stream m a
raw_union Nil yss = yss
raw_union xss Nil = xss
raw_union (Cons xs xss) (Cons ys yss) = Cons (xs ++ ys) (liftM2
raw_union xss yss)


raw_bind :: (Monad m) => m (Stream m a) -> (a -> m (Stream m b)) -> m
(Stream m b)
raw_bind xss f = xss >>= work (return Nil)
    where
    work out Nil = out
    work out (Cons xs xss) = do
        yss <- foldr (liftM2 raw_union) out $ map f xs
        return undefined
        case yss of
            Nil -> return $ Cons [] (xss >>= work (return Nil))
            Cons ys yss -> return $ Cons ys (xss >>= work yss)


from_list :: (Monad m) => [[a]] -> ResultSetT m a
from_list = Pack . foldr (\xs xss -> return $ Cons xs xss) (return Nil)

to_list :: (Monad m) => ResultSetT m a -> m [[a]]
to_list (Pack m) = m >>= work
	where
	work Nil = return [[]]
	work (Cons xs xss) = liftM (xs:) (xss >>= work)
	
limit :: (Monad m) => Int -> ResultSetT m a -> ResultSetT m a
limit n (Pack xss) = Pack (xss >>= work n)
	where
	work n (Cons xs xss) | n > 0 = return $ Cons xs (xss >>= work (n-1))
	work _ _ = return Nil

-- 
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>