Proposal: add ifM and whenM to Control.Monad
Tom Ellis
tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk
Mon Apr 21 09:57:41 UTC 2014
On Sun, Apr 20, 2014 at 04:10:34PM -0500, John Wiegley wrote:
> >>>>> Edward Kmett <ekmett at gmail.com> writes:
> > However, given that they keep getting reinvented with the exact same names
> > and functionality. I'm finally ready to give in.
>
> > +1 from me.
>
> How about a more general combinator, like om (name needed)?
>
> om :: Monad m => (a -> b -> m c) -> m a -> b -> m c
> om f m = (m >>=) . flip f
>
> whenM = om when
> unlessM = om unless
How about a completely general way of feeding arguments into a function,
some of which are in a monad, some not?
All you need is a combinator (<*>|) which indicates when you've supplied all
the arguments. It can be read as "done" or something like that. Using it
looks a bit odd but could be neatened up at the expense of adding even
*more* combinators!
Anyway, it completely obviates the need for ifM/whenM/unlessM and om, as far
as I can tell.
Tom
import Control.Monad
import System.Directory
import Control.Applicative
import Control.Lens
infixl 4 <*>|
(<*>|) :: Monad m => m (a -> m b) -> m a -> m b
f <*>| x = join (f `ap` x)
-- Here's how you can mix arguments in a monad with those that are not
f :: Monad m => a -> b -> m c -> d -> m e -> m f
f = undefined
g :: (Monad m, Applicative m) => m a -> m b -> m c -> m d -> m e -> m f
g a b c d e = f <$> a <*> b <*> pure c <*> pure d <*>| pure e
-- Here's another example
f' :: Monad m => a -> b -> m c -> d -> m e -> f -> m g
f' = undefined
g' :: (Monad m, Applicative m) => m a -> m b -> m c -> m d -> m e -> m f
-> m g
g' a b c d e f = f' <$> a <*> b <*> pure c <*> pure d <*> pure e <*>| f
-- Implementing whenM and unlessM is easy. No om required.
whenM :: (Monad m, Applicative m) => m Bool -> m () -> m ()
whenM cond action = when <$> cond <*>| pure action
unlessM :: (Monad m, Applicative m) => m Bool -> m () -> m ()
unlessM cond action = unless <$> cond <*>| pure action
-- But the point is that you don't actually need whenM and unlessM, since
-- it's easy to feed arguments to when and unless directly.
path = undefined
usingUnless = unless <$> doesDirectoryExist path <*>| pure (do
putStrLn $ "Creating directory " ++ path
createDirectory path)
More information about the Libraries
mailing list