Add an extra class to Control.Applicative.Alternative

Edward Kmett ekmett at gmail.com
Thu May 1 17:45:40 UTC 2014


My use of Either was predicated on an interpretation that something was
either pure or impure, not that getPure was trying to extract part of the
whole.

-Edward


On Thu, May 1, 2014 at 7:19 AM, S D Swierstra <doaitse at swierstra.net> wrote:

>
> On 30 Apr 2014, at 15:50 , Edward Kmett <ekmett at gmail.com> wrote:
>
> A few thoughts:
>
> * Splittable has been used as a name historically for splitting random
> number generators and the like, so the name conflict (especially from
> somewhere so prominent) would be unfortunate. That can of course be fixed
> by a simple bikeshedding exercise.
>
> * You should be able to implement this in one pass. e.g. f a -> Either a
> (f a) rather than as two combinators, but it isn't clear to me what the
> getNonPure branch can do other than return the original when the scan fails
> or some partially zonked/expanded version of it.
>
>
> I have probably not been clear enough. The relationship that should hold
> between getPure and getNonPure is as follows:
>
> case (getPure p, genNonPure p) of
>   (Nothing, Nothing)       -> "should not happen since p should have at
> least a pure or a nonpure part"
>   (Just pp,  Just npp)        -> pure pp <|> npp
>   (Just np,  Nothing)        -> pure np
>   (Nothing, Just npp)       -> npp
>
> is equivalent to p.
>
>
> I do not see how this would correspond to your use of Either?
>
>  Doaitse
>
>
>
>
>
> * Personally, I'm rather hesitant, as there are a lot of points in the
> design space and it isn't apparent how to implement/lift it for instance
> over any of the monad transformers we have, so it is the kind of class that
> lifting it too high up the import hierarchy will lead to users being forced
> to write orphans, when they disagree about whether, say writer (mempty, a)
> should be an effect or not or if you should be have instance (Monad m,
> Splittable m, Eq s) => Splittable (StateT s m).
>
> * The lack of any constraints on `f` tying it to anything else in
> Control.Applicative gives me pause. Without any relationship to other types
> it is harder to specify the laws and make them feel coherent rather than
> bolted on.
>
>
> I think the code above clearly describes the relationship.
>
>
>
> Off the cuff, I'm currently -1 on this proposal, almost entirely because
> of the concern I'd have that pushing it too far up the class hierarchy
> actually invites a worse experience due to orphans than leaving it closer
> to the use site where such ambiguous cases can be resolved unilaterally by
> the author or ignored as irrelevant by them safely.
>
> -Edward
>
>
>
> On Wed, Apr 30, 2014 at 5:58 AM, Doaitse Swierstra <doaitse at swierstra.net>wrote:
>
>> In the package uu-interleaved I introduce a new class
>>
>> class Splittable f where
>>  getNonPure :: f a -> Maybe (f a)Source
>>  getPure :: f a -> Maybe aSource
>>
>> which I use for splitting an applicative value into its pure and its
>> non-pure part. This is then used in the rest of this package to define
>> (non-ambiguous) interleaved structures (as a generalisation of permuted
>> structures).
>>
>> My feeling that this class should be better located in
>> Control.Applicative.Alternative.
>>
>> If you agree what are the steps to be taken?
>>
>>  Doaitse
>>
>>
>>
>>
>>
>>
>>
>> On 01 Nov 2013, at 14:08 , Twan van Laarhoven <twanvl at gmail.com> wrote:
>>
>> > On 01/11/13 12:44, Nathan van Doorn wrote:
>> >> Firstly, I don't see how IO is relevant here, it has neither a
>> MonadPlus
>> >> instance nor an Alternative instance.
>> >
>> > You are right. I thought it was an instance with mzero=fail "foo" and
>> mplus=catch. But I was apparently mistaken. Objection withdrawn.
>> >
>> >> Secondly, the MonadPlus laws are documented in Control.Monad to be:
>> >>
>> >>    mzero >>= f = mzero
>> >>    v >> mzero = mzero
>> >
>> > I missed them, because they are written in the documentation of mzero
>> rather than the documentation of the class where I expected them.
>> >
>> >> Thirdly, the monoid laws are already documented. (<|>) must be "An
>> associative
>> >> binary operation", and empty "The identity of <|>". These are exactly
>> the monoid
>> >> laws. Perhaps they should be made more explicit, but that is a
>> different issue.
>> >
>> > Missed this as well.
>> >
>> >> Fourthly, [] fulfils neither the left-distribution law or the
>> left-catch law,
>> >> and I doubt many people would be happy to lose []'s MonadPlus instance.
>> >
>> > List does satisfy left distribution:
>> >
>> > λ> (,) <$> ([1,2] <|> [3]) <*> [4,5]
>> > [(1,4),(1,5),(2,4),(2,5),(3,4),(3,5)]
>> > λ> (,) <$> [1,2] <*> [4,5] <|> (,) <$> [3] <*> [4,5]
>> > [(1,4),(1,5),(2,4),(2,5),(3,4),(3,5)]
>> > λ> quickCheck (\x y z -> ((,) <$> (x <|> y :: [Int]) <*> (z :: [Int]))
>> >                      == (((,) <$> x <*> z) <|> ((,) <$> y <*> z)))
>> > +++ OK, passed 100 tests.
>> >
>> > See also http://www.haskell.org/haskellwiki/MonadPlus. Then law which
>> it doesn't is right distribution.
>> >
>> > Consider Maybe. it does satisfies left catch but not left distribution
>> for MonadPlus. Since
>> >  mplus (Just False >>= guard) (Just True >>= guard) = Just ()
>> > while
>> >  mplus (Just False) (Just True) >>= guard = Nothing
>> >
>> > But for Alternative, you can't have the failure of the second argument
>> of (<*>) depend on the first. So Maybe *does* satisfy left distribution for
>> Alternative. IMO that makes it a good candidate law.
>> >
>> >
>> > Twan
>> >
>> >> I believe I have addressed all your issues. If I've missed something,
>> please
>> >> point it out to me.
>> >>
>> >> Nathan.
>> >>
>> >>
>> >> On 1 November 2013 12:09, Twan van Laarhoven <twanvl at gmail.com
>> >> <mailto:twanvl at gmail.com>> wrote:
>> >>
>> >>    On 01/11/13 11:42, Nathan van Doorn wrote:
>> >>
>> >>        Proposal: add the following laws to the documentation of
>> >>        Control.Applicative.__Alternative:
>> >>
>> >>           * empty <*> a = empty
>> >>           * f <*> empty = empty
>> >>
>> >>     > These laws correspond to the laws given in MonadPlus- if you
>> take mzero =
>> >>     > empty and ap = (<*>), the ones in MonadPlus imply these- and I
>> don't think
>> >>     > this proposal should be too controversial.
>> >>
>> >>    As far as I can see, the documentation for MonadPlus does not
>> specify these
>> >>    laws anywhere [1,2].
>> >>
>> >>    Consider the IO monad. These laws claim that
>> >>
>> >>         launchMissiles *> fail "empty" = fail "empty"
>> >>
>> >>    This is clearly *not* true.
>> >>
>> >>    --
>> >>
>> >>    If we add laws, I think we should first consider the much more
>> reasonable
>> >>    monoid laws
>> >>
>> >>         identity
>> >>           empty <|> a = a
>> >>           a <|> empty = a
>> >>         associativity:
>> >>           (a <|> b) <|> c = a <|> (b <|> c)
>> >>
>> >>    In the MonadPlus world, the controversial part is the choice between
>> >>
>> >>         left distribution
>> >>           (f <|> g) <*> a = (f <*> a) <|> (g <*> a)
>> >>
>> >>    or
>> >>
>> >>         left catch
>> >>           pure a <|> b = pure a
>> >>
>> >>    Your proposal would be
>> >>
>> >>         left zero
>> >>
>> >>           empty <*> a = empty
>> >>         right zero
>> >>
>> >>           f <*> empty = empty
>> >>
>> >>    And as mentioned above, right zero is problematic. The fmap version
>> should
>> >>    be okay though
>> >>
>> >>          map zero
>> >>           f <$> empty = empty
>> >>
>> >>
>> >>    Twan
>> >>
>> >>    [1]
>> >>
>> http://hackage.haskell.org/__package/base-4.6.0.1/docs/__Control-Monad.html#t:MonadPlus
>> >>    <
>> http://hackage.haskell.org/package/base-4.6.0.1/docs/Control-Monad.html#t:MonadPlus
>> >
>> >>    [2] http://www.haskell.org/__haskellwiki/MonadPlus
>> >>    <http://www.haskell.org/haskellwiki/MonadPlus>
>> >>    _________________________________________________
>> >>    Libraries mailing list
>> >>    Libraries at haskell.org <mailto:Libraries at haskell.org>
>> >>    http://www.haskell.org/__mailman/listinfo/libraries
>> >>    <http://www.haskell.org/mailman/listinfo/libraries>
>> >>
>> >>
>> >
>> > _______________________________________________
>> > 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
>>
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/libraries/attachments/20140501/48134a9e/attachment.html>


More information about the Libraries mailing list