[Haskell-cafe] Monad transformers [Stacking monads]
David Menendez
dave at zednenem.com
Tue Oct 7 17:53:23 EDT 2008
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/>
More information about the Haskell-Cafe
mailing list