While the rules claim that a prefix m stands for a generalization to monadic form, in practice it is a generalization to Monoid or MonadPlus. If we look at names starting with m, we find:
mplus
msum
mfilter
All of them operate on MonadPlus. None of these functions are straightforward generalizations where arguments or results are wrapped in a monad, rather they replace addition or concatenation by the MonadPlus monoidal operation.
In the base library the other names prefixed with 'm' are mappend and mconcat from Data.Monoid. Again these are monoidal operations. So to me, 'm' means "monoidal", not "monadic generalization".
-1 for mif, mwhen, munless.
Twan
On 2014-04-21 00:35, Edward Kmett wrote:
mif appears to pass the naming convention rules. It looks strange, but we can
chalk that up to lack of exposure.
The principal use of ' in base is for adding strictness, and when' and unless'
don't fit that pattern. Looking at
it in code doesn't send a signal that most users would pick up that an extra
monadic effect is going on.
-Edward
On Sun, Apr 20, 2014 at 6:22 PM, Mario Pastorelli <pastorelli.mario@gmail.com<mailto:pastorelli.mario@gmail.com>> wrote:
when' and unless' are good names in my opinion. In Haskell libs ' is often
used to define a similar function to another one.
For if' we could use the third convention. Its type is:
if :: Bool -> a -> a -> a
and by prefixing 'm' we can change it to be monadic:
mif :: (Monad m) => m Bool -> m a -> m a -> m a
that stands for monadic if. I don't like the idea of having different name
notations for ifM and whenM/unlessM but that's true also for if-then-else
and when/unless. I personally don't like the name 'mif' but I don't see many
other solutions. Maybe the name 'if' isn't appropriate and it's better to
change it into something else?
On 04/20/2014 11:48 PM, Edward Kmett wrote:
if' is a commonly used name in user code for what is now called bool, but
it also gets used all over the place for 'if' inside of EDSLs.
On Sun, Apr 20, 2014 at 5:45 PM, Mario Pastorelli<pastorelli.mario@gmail.com <mailto:pastorelli.mario@gmail.com>> wrote:
I see. Another solution is to use if', when' and unless'.
On 04/20/2014 11:42 PM, Edward Kmett wrote:
My mistake. These rules are still in Control.Monad. I just scrolled
right past them.
-Edward
On Sun, Apr 20, 2014 at 5:04 PM, Edward Kmett <ekmett@gmail.com<mailto:ekmett@gmail.com>> wrote:* A postfix 'M' always stands for a function in the Kleisli
The principled objection to giving these combinators the
"obvious" names in Control.Monad is that that module has
historically held to a detailed convention that these proposed
names unfortunately don't fit. =/
The functions in this library use the following naming
conventions:
* A postfix '_' changes the result type from (m a) to (m
category: The monad type constructor m is added to
function results (modulo currying) and nowhere else. So,
for example,
filter :: (a -> Bool) -> [a] -> [a]
filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
* A prefix 'm' generalizes an existing function to a
()). Thus, for example:
sequence :: Monad m => [m a] -> m [a]
sequence_ :: Monad m => [m a] -> m ()
<pastorelli.mario@gmail.com <mailto:pastorelli.mario@gmail.com>>
monadic form. Thus, for example:
sum :: Num a => [a] -> a
msum :: MonadPlus m => [m a] -> m a
That said, if we do adopt them, they probably should get the ifM,
whenM, unlessM names.
I don't think the convention has been documented in Control.Monad
itself for years.
-Edward
On Sun, Apr 20, 2014 at 4:26 PM, Mario PastorelliLibraries@haskell.org <mailto:Libraries@haskell.org>
wrote:
Hi Herbert,
in general I like pattern matching but not when boolean
values are involved. Your code is nice but, in my opinion,
still far from the elegance of
f = unlessM (doesDirectoryExist path) $ do
putStrLn $ "Creating directory " ++ path
createDirectory path
In particular, note that I don't have to take care of the
False case and the code doesn't have boilerplate.
While your solution is more general, I would like to point
out that when and unless are so useful that they got their
own functions in the library instead of relying on pattern
matching. I consider ifM, whenM and unlessM as alternate
versions of existing functions.
On 04/20/2014 09:59 PM, Herbert Valerio Riedel wrote:
Hi Mario,
On 2014-04-20 at 21:10:03 +0200, Mario Pastorelli wrote:
I would like to propose the addition of two new
combinators to
Control.Monad:
ifM :: (Monad m) => m Bool -> m a -> m a -> m a
whenM :: (Monad m) => m Bool -> m () -> m ()
[...]
f = do
dirDoesntExist <- not <$> doesDirectoryExist path
when dirDoesntExist $ do
putStrLn $ "Creating directory " ++ path
createDirectory path
While I'm neutral on this proposal, I'd like to remind
that LambdaCase
may be useful to avoid temporary variables as well (and
is even more
useful for types other than Bool):
f = doesDirectoryExist path >>= \case
True -> return ()
False -> do
putStrLn $ "Creating directory " ++ path
createDirectory path
Cheers,
hvr
_______________________________________________
Libraries mailing list
http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________
Libraries mailing list
Libraries@haskell.org
http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________
Libraries mailing list
Libraries@haskell.org
http://www.haskell.org/mailman/listinfo/libraries