Libraries Digest, Vol 117, Issue 10
kudah
kudahkukarek at gmail.com
Fri May 10 22:36:50 CEST 2013
This is nothing but obfuscation, whenJust is clearly more readable than
for_. whenJust is monomorphic too.
On Fri, 10 May 2013 11:44:42 -0700 Gabriel Gonzalez
<gabriel439 at 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 at haskell.org>
> wrote:
>
> > Send Libraries mailing list submissions to
> > libraries at 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 at haskell.org
> >
> > You can reach the person managing the list at
> > libraries-owner at 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 at gmail.com>
> > Subject: Re: Control.Monad proposal: Add whenJust
> > To: Niklas Hamb?chen <mail at nh2.me>
> > Cc: Haskell Libraries <libraries at haskell.org>
> > Message-ID:
> > <
> > CAJumaK8XJrtdrXQfVb3pdi193ghz9ZEX8Q-MnVd435tDt5YFbg at 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 at 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 at 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 at gmail.com>
> > Subject: Re: Control.Monad proposal: Add whenJust
> > To: Niklas Hamb?chen <mail at nh2.me>
> > Cc: "libraries at haskell.org" <libraries at haskell.org>
> > Message-ID:
> > <
> > CACbaDy5oCQ-xV4-c-gDNzc5L1+XzHaUAqNomCb3ZfAouwyqH3Q at 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 at 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 at haskell.org
> > > http://www.haskell.org/mailman/listinfo/libraries
> >
> >
> >
> > ------------------------------
> >
> > Message: 3
> > Date: Fri, 10 May 2013 14:04:09 +0200
> > From: Simon Hengel <sol at typeful.net>
> > Subject: Re: Control.Monad proposal: Add whenJust
> > To: Niklas Hamb?chen <mail at nh2.me>
> > Cc: libraries at haskell.org
> > Message-ID: <20130510120409.GA2858 at 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 at 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 at ifi.lmu.de>
> > Subject: Re: Control.Monad proposal: Add whenJust
> > To: Niklas Hamb?chen <mail at nh2.me>
> > Cc: libraries at haskell.org
> > Message-ID: <518CFDF6.2000002 at 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 at 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 at 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 at gmail.com>
> > Subject: Re: Control.Monad proposal: Add whenJust
> > To: Simon Hengel <sol at typeful.net>
> > Cc: libraries at haskell.org
> > Message-ID:
> > <
> > CA+u6gbxg6KaXe5etCHcKtEk8sR3-7wAhdCt2mu9S6Y47jTsJqA at 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 at 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 at haskell.org
> > >> http://www.haskell.org/mailman/listinfo/libraries
> > >
> > > _______________________________________________
> > > Libraries mailing list
> > > Libraries at haskell.org
> > > http://www.haskell.org/mailman/listinfo/libraries
> >
> >
> >
> > --
> > Ivan Lazar Miljenovic
> > Ivan.Miljenovic at gmail.com
> > http://IvanMiljenovic.wordpress.com
> >
> >
> >
> > ------------------------------
> >
> > Message: 6
> > Date: Fri, 10 May 2013 18:09:52 +0100
> > From: Ganesh Sittampalam <ganesh at earth.li>
> > Subject: Re: Control.Monad proposal: Add whenJust
> > To: Andreas Abel <andreas.abel at ifi.lmu.de>
> > Cc: libraries at haskell.org
> > Message-ID: <518D29E0.3070500 at 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 at 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 at gmail.com>
> > Subject: Re: Control.Monad proposal: Add whenJust
> > To: Evan Laforge <qdunkan at gmail.com>
> > Cc: "libraries at haskell.org" <libraries at haskell.org>
> > Message-ID:
> > <CABSda-fpnWNSLYDnffYDPDuucn4X9+Qbqn7f=
> > XUgv6muFBGWiw at mail.gmail.com>
> > Content-Type: text/plain; charset="iso-8859-1"
> >
> > 2013/5/10 Evan Laforge <qdunkan at 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 at haskell.org
> > http://www.haskell.org/mailman/listinfo/libraries
> >
> >
> > End of Libraries Digest, Vol 117, Issue 10
> > ******************************************
> >
More information about the Libraries
mailing list