Perhaps we should have a dummy module in Hackage that includes commonly searched for functions, but instead of actually implementing them the documentation would say don't use this and suggest an alternative and explains why. Then you could find them in Hoogle and Hackage seems to be highly ranked on Google so they'd be found there as well.

So a programmer would Google or Hoogle whenJust, find what they think is a module, take a look at the documentation, and find the alternative suggestion.

Chris

On 10 May 2013 11:44, Gabriel Gonzalez <gabriel439@gmail.com> wrote:
How about I just write a blog post teaching people how to use `for_` (and more generally, how to use `Maybe`'s `Foldable` instance)?  I know Oliver Charles wrote a similar post in his 24 days of Hackage, and maybe I could build on that a bit more and perhaps make it as Google-able as possible so it comes up as the top result when people search for keywords like `whenJust` and other `Maybe` idioms.


On Fri, May 10, 2013 at 11:25 AM, <libraries-request@haskell.org> wrote:
Send Libraries mailing list submissions to
        libraries@haskell.org

To subscribe or unsubscribe via the World Wide Web, visit
        http://www.haskell.org/mailman/listinfo/libraries
or, via email, send a message with subject or body 'help' to
        libraries-request@haskell.org

You can reach the person managing the list at
        libraries-owner@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Libraries digest..."


Today's Topics:

   1. Re: Control.Monad proposal: Add whenJust (Edward Kmett)
   2. Re: Control.Monad proposal: Add whenJust (Evan Laforge)
   3. Re: Control.Monad proposal: Add whenJust (Simon Hengel)
   4. Re: Control.Monad proposal: Add whenJust (Andreas Abel)
   5. Re: Control.Monad proposal: Add whenJust (Ivan Lazar Miljenovic)
   6. Re: Control.Monad proposal: Add whenJust (Ganesh Sittampalam)
   7. Re: Control.Monad proposal: Add whenJust (Petr Pudl?k)


----------------------------------------------------------------------

Message: 1
Date: Fri, 10 May 2013 07:16:53 -0400
From: Edward Kmett <ekmett@gmail.com>
Subject: Re: Control.Monad proposal: Add whenJust
To: Niklas Hamb?chen <mail@nh2.me>
Cc: Haskell Libraries <libraries@haskell.org>
Message-ID:
        <CAJumaK8XJrtdrXQfVb3pdi193ghz9ZEX8Q-MnVd435tDt5YFbg@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"

I'm -1 on this, due to it just further obfuscating the fact that
Data.Foldable.for_ already exists.


On Fri, May 10, 2013 at 2:13 AM, Niklas Hamb?chen <mail@nh2.me> wrote:

> I would like to propose the addition of
>
> whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
> whenJust (Just x) f = f x
> whenJust _        _ = return ()
>
> to Control.Monad, in the section
>
>    "Conditional execution of monadic expressions"
>
> next to
>
>    guard :: MonadPlus m => Bool -> m ()
>    when :: Monad m => Bool -> m () -> m ()
>    unless :: Monad m => Bool -> m () -> m ()
>
>
> Why?
>
> It would allow us to write more readable code and fit well into the
> group of similar functions of this style.
>
> Compare
>
>    mUser <- lookupUser
>
>    whenJust mUser email
>
> or
>
>    whenJust mUser $ \user -> do
>       putStrLn "Mailing!"
>       email user
>
> with some currently available alternatives:
>
>
>    case mUser of
>       Just user -> do putStrLn "Mailing!"
>                       email user
>       Nothing   -> return ()
>
> (Default base case clutter.)
>
>
>    import Data.Foldable
>
>    forM_ mUser $ \user -> do
>      putStrLn "Mailing!"
>      email user
>
> (Not too intuitive/well-named here and "Ambiguous occurrence forM_"
> clash with Control.Monad.)
>
> Some more dissatisfying alternatives:
>
>
>    maybe (return ()) (\user -> do putStrLn "Mailing!"
>                                   email user
>                      ) mUser
>
>
>    flip (maybe (return ())) mUser $ \user -> do
>      putStrLn "Mailing!"
>      email user
>
>
>    import Control.Monad.Trans.Maybe
>    import Control.Monad.Trans (lift)
>
>    _ <- runMaybeT $ return mUser >>= \user -> lift $ do
>      putStrLn "Mailing!"
>      email user
>    return ()
>
>
> Alternative names:
>
>    - withJust, analog to withFile and withForeignPtr
>
> Any comments?
>
> _______________________________________________
> Libraries mailing list
> Libraries@haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/libraries/attachments/20130510/ad34bbe5/attachment-0001.htm>

------------------------------

Message: 2
Date: Fri, 10 May 2013 18:30:14 +0700
From: Evan Laforge <qdunkan@gmail.com>
Subject: Re: Control.Monad proposal: Add whenJust
To: Niklas Hamb?chen <mail@nh2.me>
Cc: "libraries@haskell.org" <libraries@haskell.org>
Message-ID:
        <CACbaDy5oCQ-xV4-c-gDNzc5L1+XzHaUAqNomCb3ZfAouwyqH3Q@mail.gmail.com>
Content-Type: text/plain; charset=UTF-8

I like it, I have a local whenJust I use very frequently.

I know about forM_, but I don't use it because it sounds too much like a loop.

But I recall we already had this discussion and it failed to catch on
then, so unless something has changed it might not be worth bringing
it up again.

On Fri, May 10, 2013 at 1:13 PM, Niklas Hamb?chen <mail@nh2.me> wrote:
> I would like to propose the addition of
>
> whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
> whenJust (Just x) f = f x
> whenJust _        _ = return ()
>
> to Control.Monad, in the section
>
>    "Conditional execution of monadic expressions"
>
> next to
>
>    guard :: MonadPlus m => Bool -> m ()
>    when :: Monad m => Bool -> m () -> m ()
>    unless :: Monad m => Bool -> m () -> m ()
>
>
> Why?
>
> It would allow us to write more readable code and fit well into the
> group of similar functions of this style.
>
> Compare
>
>    mUser <- lookupUser
>
>    whenJust mUser email
>
> or
>
>    whenJust mUser $ \user -> do
>       putStrLn "Mailing!"
>       email user
>
> with some currently available alternatives:
>
>
>    case mUser of
>       Just user -> do putStrLn "Mailing!"
>                       email user
>       Nothing   -> return ()
>
> (Default base case clutter.)
>
>
>    import Data.Foldable
>
>    forM_ mUser $ \user -> do
>      putStrLn "Mailing!"
>      email user
>
> (Not too intuitive/well-named here and "Ambiguous occurrence forM_"
> clash with Control.Monad.)
>
> Some more dissatisfying alternatives:
>
>
>    maybe (return ()) (\user -> do putStrLn "Mailing!"
>                                   email user
>                      ) mUser
>
>
>    flip (maybe (return ())) mUser $ \user -> do
>      putStrLn "Mailing!"
>      email user
>
>
>    import Control.Monad.Trans.Maybe
>    import Control.Monad.Trans (lift)
>
>    _ <- runMaybeT $ return mUser >>= \user -> lift $ do
>      putStrLn "Mailing!"
>      email user
>    return ()
>
>
> Alternative names:
>
>    - withJust, analog to withFile and withForeignPtr
>
> Any comments?
>
> _______________________________________________
> Libraries mailing list
> Libraries@haskell.org
> http://www.haskell.org/mailman/listinfo/libraries



------------------------------

Message: 3
Date: Fri, 10 May 2013 14:04:09 +0200
From: Simon Hengel <sol@typeful.net>
Subject: Re: Control.Monad proposal: Add whenJust
To: Niklas Hamb?chen <mail@nh2.me>
Cc: libraries@haskell.org
Message-ID: <20130510120409.GA2858@x200>
Content-Type: text/plain; charset=iso-8859-1

-1

Personally I think forM_ is the way to go.

On Fri, May 10, 2013 at 02:13:45PM +0800, Niklas Hamb?chen wrote:
> I would like to propose the addition of
>
> whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
> whenJust (Just x) f = f x
> whenJust _        _ = return ()
>
> to Control.Monad, in the section
>
>    "Conditional execution of monadic expressions"
>
> next to
>
>    guard :: MonadPlus m => Bool -> m ()
>    when :: Monad m => Bool -> m () -> m ()
>    unless :: Monad m => Bool -> m () -> m ()
>
>
> Why?
>
> It would allow us to write more readable code and fit well into the
> group of similar functions of this style.
>
> Compare
>
>    mUser <- lookupUser
>
>    whenJust mUser email
>
> or
>
>    whenJust mUser $ \user -> do
>       putStrLn "Mailing!"
>       email user
>
> with some currently available alternatives:
>
>
>    case mUser of
>       Just user -> do putStrLn "Mailing!"
>                       email user
>       Nothing   -> return ()
>
> (Default base case clutter.)
>
>
>    import Data.Foldable
>
>    forM_ mUser $ \user -> do
>      putStrLn "Mailing!"
>      email user
>
> (Not too intuitive/well-named here and "Ambiguous occurrence forM_"
> clash with Control.Monad.)
>
> Some more dissatisfying alternatives:
>
>
>    maybe (return ()) (\user -> do putStrLn "Mailing!"
>                                   email user
>                      ) mUser
>
>
>    flip (maybe (return ())) mUser $ \user -> do
>      putStrLn "Mailing!"
>      email user
>
>
>    import Control.Monad.Trans.Maybe
>    import Control.Monad.Trans (lift)
>
>    _ <- runMaybeT $ return mUser >>= \user -> lift $ do
>      putStrLn "Mailing!"
>      email user
>    return ()
>
>
> Alternative names:
>
>    - withJust, analog to withFile and withForeignPtr
>
> Any comments?
>
> _______________________________________________
> Libraries mailing list
> Libraries@haskell.org
> http://www.haskell.org/mailman/listinfo/libraries



------------------------------

Message: 4
Date: Fri, 10 May 2013 16:02:30 +0200
From: Andreas Abel <andreas.abel@ifi.lmu.de>
Subject: Re: Control.Monad proposal: Add whenJust
To: Niklas Hamb?chen <mail@nh2.me>
Cc: libraries@haskell.org
Message-ID: <518CFDF6.2000002@ifi.lmu.de>
Content-Type: text/plain; charset=ISO-8859-1; format=flowed

+1

I use whenJust quite frequently and it is much more readable than for_
(wrong connotation) or

   flip (maybe $ return ())

Cheers,
Andreas

On 10.05.13 8:13 AM, Niklas Hamb?chen wrote:
> I would like to propose the addition of
>
> whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
> whenJust (Just x) f = f x
> whenJust _        _ = return ()
>
> to Control.Monad, in the section
>
>     "Conditional execution of monadic expressions"
>
> next to
>
>     guard :: MonadPlus m => Bool -> m ()
>     when :: Monad m => Bool -> m () -> m ()
>     unless :: Monad m => Bool -> m () -> m ()
>
>
> Why?
>
> It would allow us to write more readable code and fit well into the
> group of similar functions of this style.
>
> Compare
>
>     mUser <- lookupUser
>
>     whenJust mUser email
>
> or
>
>     whenJust mUser $ \user -> do
>        putStrLn "Mailing!"
>        email user
>
> with some currently available alternatives:
>
>
>     case mUser of
>        Just user -> do putStrLn "Mailing!"
>                        email user
>        Nothing   -> return ()
>
> (Default base case clutter.)
>
>
>     import Data.Foldable
>
>     forM_ mUser $ \user -> do
>       putStrLn "Mailing!"
>       email user
>
> (Not too intuitive/well-named here and "Ambiguous occurrence forM_"
> clash with Control.Monad.)
>
> Some more dissatisfying alternatives:
>
>
>     maybe (return ()) (\user -> do putStrLn "Mailing!"
>                                    email user
>                       ) mUser
>
>
>     flip (maybe (return ())) mUser $ \user -> do
>       putStrLn "Mailing!"
>       email user
>
>
>     import Control.Monad.Trans.Maybe
>     import Control.Monad.Trans (lift)
>
>     _ <- runMaybeT $ return mUser >>= \user -> lift $ do
>       putStrLn "Mailing!"
>       email user
>     return ()
>
>
> Alternative names:
>
>     - withJust, analog to withFile and withForeignPtr
>
> Any comments?
>
> _______________________________________________
> Libraries mailing list
> Libraries@haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>

--
Andreas Abel  <><      Du bist der geliebte Mensch.

Theoretical Computer Science, University of Munich
Oettingenstr. 67, D-80538 Munich, GERMANY

andreas.abel@ifi.lmu.de
http://www2.tcs.ifi.lmu.de/~abel/



------------------------------

Message: 5
Date: Sat, 11 May 2013 00:25:04 +1000
From: Ivan Lazar Miljenovic <ivan.miljenovic@gmail.com>
Subject: Re: Control.Monad proposal: Add whenJust
To: Simon Hengel <sol@typeful.net>
Cc: libraries@haskell.org
Message-ID:
        <CA+u6gbxg6KaXe5etCHcKtEk8sR3-7wAhdCt2mu9S6Y47jTsJqA@mail.gmail.com>
Content-Type: text/plain; charset=UTF-8

-1

Wasn't there a similar proposal to this last year?

On 10 May 2013 22:04, Simon Hengel <sol@typeful.net> wrote:
> -1
>
> Personally I think forM_ is the way to go.
>
> On Fri, May 10, 2013 at 02:13:45PM +0800, Niklas Hamb?chen wrote:
>> I would like to propose the addition of
>>
>> whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
>> whenJust (Just x) f = f x
>> whenJust _        _ = return ()
>>
>> to Control.Monad, in the section
>>
>>    "Conditional execution of monadic expressions"
>>
>> next to
>>
>>    guard :: MonadPlus m => Bool -> m ()
>>    when :: Monad m => Bool -> m () -> m ()
>>    unless :: Monad m => Bool -> m () -> m ()
>>
>>
>> Why?
>>
>> It would allow us to write more readable code and fit well into the
>> group of similar functions of this style.
>>
>> Compare
>>
>>    mUser <- lookupUser
>>
>>    whenJust mUser email
>>
>> or
>>
>>    whenJust mUser $ \user -> do
>>       putStrLn "Mailing!"
>>       email user
>>
>> with some currently available alternatives:
>>
>>
>>    case mUser of
>>       Just user -> do putStrLn "Mailing!"
>>                       email user
>>       Nothing   -> return ()
>>
>> (Default base case clutter.)
>>
>>
>>    import Data.Foldable
>>
>>    forM_ mUser $ \user -> do
>>      putStrLn "Mailing!"
>>      email user
>>
>> (Not too intuitive/well-named here and "Ambiguous occurrence forM_"
>> clash with Control.Monad.)
>>
>> Some more dissatisfying alternatives:
>>
>>
>>    maybe (return ()) (\user -> do putStrLn "Mailing!"
>>                                   email user
>>                      ) mUser
>>
>>
>>    flip (maybe (return ())) mUser $ \user -> do
>>      putStrLn "Mailing!"
>>      email user
>>
>>
>>    import Control.Monad.Trans.Maybe
>>    import Control.Monad.Trans (lift)
>>
>>    _ <- runMaybeT $ return mUser >>= \user -> lift $ do
>>      putStrLn "Mailing!"
>>      email user
>>    return ()
>>
>>
>> Alternative names:
>>
>>    - withJust, analog to withFile and withForeignPtr
>>
>> Any comments?
>>
>> _______________________________________________
>> 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



--
Ivan Lazar Miljenovic
Ivan.Miljenovic@gmail.com
http://IvanMiljenovic.wordpress.com



------------------------------

Message: 6
Date: Fri, 10 May 2013 18:09:52 +0100
From: Ganesh Sittampalam <ganesh@earth.li>
Subject: Re: Control.Monad proposal: Add whenJust
To: Andreas Abel <andreas.abel@ifi.lmu.de>
Cc: libraries@haskell.org
Message-ID: <518D29E0.3070500@earth.li>
Content-Type: text/plain; charset=ISO-8859-1

For what it's worth, F# has Option.iter, analogous to List.iter,
Array.iter etc: http://msdn.microsoft.com/en-GB/library/ee340387.aspx

I did find it a bit funny initially but it's grown on me.

Ganesh

On 10/05/2013 15:02, Andreas Abel wrote:
> +1
>
> I use whenJust quite frequently and it is much more readable than for_
> (wrong connotation) or
>
>   flip (maybe $ return ())
>
> Cheers,
> Andreas
>
> On 10.05.13 8:13 AM, Niklas Hamb?chen wrote:
>> I would like to propose the addition of
>>
>> whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
>> whenJust (Just x) f = f x
>> whenJust _        _ = return ()
>>
>> to Control.Monad, in the section
>>
>>     "Conditional execution of monadic expressions"
>>
>> next to
>>
>>     guard :: MonadPlus m => Bool -> m ()
>>     when :: Monad m => Bool -> m () -> m ()
>>     unless :: Monad m => Bool -> m () -> m ()
>>
>>
>> Why?
>>
>> It would allow us to write more readable code and fit well into the
>> group of similar functions of this style.
>>
>> Compare
>>
>>     mUser <- lookupUser
>>
>>     whenJust mUser email
>>
>> or
>>
>>     whenJust mUser $ \user -> do
>>        putStrLn "Mailing!"
>>        email user
>>
>> with some currently available alternatives:
>>
>>
>>     case mUser of
>>        Just user -> do putStrLn "Mailing!"
>>                        email user
>>        Nothing   -> return ()
>>
>> (Default base case clutter.)
>>
>>
>>     import Data.Foldable
>>
>>     forM_ mUser $ \user -> do
>>       putStrLn "Mailing!"
>>       email user
>>
>> (Not too intuitive/well-named here and "Ambiguous occurrence forM_"
>> clash with Control.Monad.)
>>
>> Some more dissatisfying alternatives:
>>
>>
>>     maybe (return ()) (\user -> do putStrLn "Mailing!"
>>                                    email user
>>                       ) mUser
>>
>>
>>     flip (maybe (return ())) mUser $ \user -> do
>>       putStrLn "Mailing!"
>>       email user
>>
>>
>>     import Control.Monad.Trans.Maybe
>>     import Control.Monad.Trans (lift)
>>
>>     _ <- runMaybeT $ return mUser >>= \user -> lift $ do
>>       putStrLn "Mailing!"
>>       email user
>>     return ()
>>
>>
>> Alternative names:
>>
>>     - withJust, analog to withFile and withForeignPtr
>>
>> Any comments?
>>
>> _______________________________________________
>> Libraries mailing list
>> Libraries@haskell.org
>> http://www.haskell.org/mailman/listinfo/libraries
>>
>




------------------------------

Message: 7
Date: Fri, 10 May 2013 20:25:05 +0200
From: Petr Pudl?k <petr.mvd@gmail.com>
Subject: Re: Control.Monad proposal: Add whenJust
To: Evan Laforge <qdunkan@gmail.com>
Cc: "libraries@haskell.org" <libraries@haskell.org>
Message-ID:
        <CABSda-fpnWNSLYDnffYDPDuucn4X9+Qbqn7f=XUgv6muFBGWiw@mail.gmail.com>
Content-Type: text/plain; charset="iso-8859-1"

2013/5/10 Evan Laforge <qdunkan@gmail.com>

> I know about forM_, but I don't use it because it sounds too much like a
> loop.
>

I'd say `forM_` is more like "for each" for a collection (rather than
C-style "for" loop), which makes perfect sense for Maybe. So I prefer
`forM_` instead of adding a new function.

Petr
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/libraries/attachments/20130510/8498fda1/attachment.htm>

------------------------------

_______________________________________________
Libraries mailing list
Libraries@haskell.org
http://www.haskell.org/mailman/listinfo/libraries


End of Libraries Digest, Vol 117, Issue 10
******************************************


_______________________________________________
Libraries mailing list
Libraries@haskell.org
http://www.haskell.org/mailman/listinfo/libraries