Hello Joachim,
I don't really understand what you're doing here. There's the obvious
mapM_ (act2 >=> act1)
But presumably act1 performs some monadic action that doesn't depend on its input, and you need that to be performed before act2?
To me, it feels like there's some sort of implicit coupling between act1 and act2, and you would be better off extracting that, perhaps by changing act1 to have the type act1 :: M T -> () .
If that's not possible, your approach seems pretty simple to me.
John L.
Dear List,
a little puzzle.
Given a monad M with a MonadFix instance, and these two functions:
act1 :: T -> M ()
act2 :: a -> M T
I morally want to write this function:
foo :: [a] -> M ()
foo = mdo
mapM_ act1 xs
xs <- mapM act2
return ()
Unfortunately, that will not work: mapM_ will force xs before any of it
can be generated. But morally it should be possible, as the lists passed
to mapM_ and mapM have the same, already known list.
So here is my solution (which is a bit more general, because I happen to
need some that in one place):
mapFstMapSnd :: MonadFix m => [(a -> m (), m a)] -> m ()
mapFstMapSnd xs = const () `liftM` go xs (return [])
where
go [] cont = cont
go ((f,s):xs) cont = mdo
f v
(v:vs) <- go xs $ do
vs <- cont
v <- s
return (v:vs)
return vs
Using that, I can write
foo = mapFstSnd . map (x -> (act1, act2 x))
Are there better solutions? Simpler ones? Or possibly ones that do not
require a partial pattern?
Hmm, and thinking while writing lets me come up with
data FunSplit m where
FunSplit :: forall m a . (a -> m ()) -> m a -> FunSplit m
mapFstMapSnd :: forall m. MonadFix m => [FunSplit m] -> m ()
mapFstMapSnd xs = const () `liftM` go xs (return ())
where
go :: [FunSplit m] -> m b -> m b
go [] cont = cont
go (FunSplit f s:xs) cont = mdo
f v
(v,vs) <- go xs $ do
vs <- cont
v <- s
return (v,vs)
return vs
foo :: [SPut] -> SPut
foo = mapFstMapSnd . map go
where go x = FunSplit act1 (act2 x)
Any suggestions for improvement?
Thanks,
Joachim
--
Joachim Breitner
e-Mail: mail@joachim-breitner.de
Homepage: http://www.joachim-breitner.de
Jabber-ID: nomeata@joachim-breitner.de
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe