Monad of no `return` Proposal (MRP): Moving `return` out of `Monad`

John Lato jwlato at gmail.com
Mon Sep 28 18:52:24 UTC 2015


IME the community has a group that's highly skeptical of breaking changes
with little-to-no benefit.  Renaming either pure or return I think would
qualify, as the breakage would be extensive, and the resulting language
would be identical modulo the renaming, i.e. no extra expressiveness is
granted.  AMP addressed a long-standing pain point of the language and had
a well-thought-out transition scheme, and Typeable is only rarely used by
hand so the breakage wasn't actually that extensive.

My biggest concern with this proposal is the breakage of
mostly-unmaintained but working packages.  As with ekmett, I'm in favor
provided that there's a sufficiently well-planned transition period.
Providing a minor ghc release that warns about any superfluous 'return'
definitions would be very helpful.

On Sat, Sep 26, 2015 at 5:05 PM Richard Eisenberg <eir at cis.upenn.edu> wrote:

> Thanks for making this proposal.
>
> I'm leery of the breakage that this would cause. But, there has been no
> chorus of voices complaining about breaking changes in the recent past (AMP
> and changes to Typeable are top on my mind), so perhaps our community is
> more tolerant of breakage than I would guess.
>
> Given that, I'm +1 on this.
>
> The one point of this proposal that's gotten some debate is preferring
> `pure` or preferring `return`. (I'm considering any contemplation of other
> names to be more noise than signal. Besides, I interpret most [all?] of
> those emails to be in varying degrees of jest.)
>
> I vote for `pure` over `return`. Although some have pointed out that
> `return` feels more natural to those coming from other languages, it is a
> false friend [1]. `return` is emphatically not a language construct in
> Haskell, and it has no effect on flow control. On the other hand `pure`
> embeds a pure bit in an effectful computation. When I say do { x ; pure $ y
> }, `y` is indeed pure, as the function suggests. I think this is a much
> simpler approach than trying to convince skeptical Java programmers that
> `return` is nothing special.
>
> Richard
>
> [1]: https://en.wikipedia.org/wiki/False_friend
>
> On Sep 24, 2015, at 5:43 PM, Herbert Valerio Riedel <hvr at gnu.org> wrote:
>
> > Hello *,
> >
> > Concluding AMP and MFP, We (David and I) proudly present you the final
> > installment of the Monad trilogy:
> >
> >
> > Monad of no `return` Proposal
> > =============================
> >
> > TLDR: To complete the AMP, turn `Monad(return)` method into a
> >      top-level binding aliasing `Applicative(pure)`.
> >
> >
> > Current Situation
> > -----------------
> >
> > With the implementation of Functor-Applicative-Monad Proposal (AMP)[1]
> and
> > (at some point) the MonadFail proposal (MFP)[2] the AMP class hierarchy
> > becomes
> >
> >
> >    class  Functor f  where
> >        fmap    :: (a -> b) -> f a -> f b
> >
> >
> >    class  Functor f => Applicative f  where
> >        pure    :: a -> f a
> >        (<*>)   :: f (a -> b) -> f a -> f b
> >
> >        (*>)    :: f a -> f b -> f b
> >        u *> v  = …
> >
> >        (<*)    :: f a -> f b -> f a
> >        u <* v  = …
> >
> >
> >    class  Applicative m => Monad m  where
> >        (>>=)   :: m a -> (a -> m b) -> m b
> >
> >        return  :: a -> m a
> >        return  = pure
> >
> >        (>>)    :: m a -> m b -> m b
> >        m >> k  = …
> >
> >
> >    class  Monad m => MonadFail m  where
> >        fail    :: String -> m a
> >
> >
> > Consequently, the `Monad` class is left with a now redundant `return`
> > method as a historic artifact, as there's no compelling reason to
> > have `pure` and `return` implemented differently.
> >
> > Traditionally, `return` is often used where `pure` would suffice
> > today, forcing a `Monad` constraint even if a weaker `Applicative`
> > would have sufficed.
> >
> > As a result, language extensions like `ApplicativeDo`[3] have to
> > rewrite `return` to weaken its `Monad m =>` constraint to
> > `Applicative m =>` in order to benefit existing code at the cost
> > of introducing magic behavior at the type level.
> >
> > Finally, this redundancy becomes even more significant when viewed in
> > light of the renewed Haskell standardisation process[7]: The next
> > Haskell Report will almost certainly incorporate the AMP (and MFP)
> > changes, and there's no justification for the Report to retain
> > `return` as a method of `Monad`. A good reason would have been to
> > retain backward compatibility with Haskell 2010. However, as the AMP
> > superclass hierarchy requires `Monad` instances to be accompanied by
> > `Applicative` instances (which aren't part of Haskell 2010, c.f. [6]),
> > backward compatibility with Haskell 2010 goes out the window when it
> > comes to defining `Monad` instances (unless via use of `-XCPP` or
> > similar).  Consequently, meeting the high bar for a formal document
> > such as the Haskell Report demands that `Monad` shall not carry a
> > redundant `return` method that serves no purpose anymore. Moreover,
> > getting `return` out of the way is desirable to facilitate
> > standardising potential candidates such as the earlier mentioned
> > `ApplicativeDo` in the future and avoids the technical debt incurred
> > by keeping around this language wart.
> >
> >
> > Proposed Change
> > ---------------
> >
> > Remove `return` as a method from the `Monad` class and in its place
> > define a top-level binding with the weaker `Applicative` typeclass
> > constraint:
> >
> >
> >    -- | Legacy alias for 'pure'
> >    return :: Applicative f => a -> f a
> >    return = pure
> >
> >
> > This allows existing code using `return` to benefit from a weaker
> > typeclass constraint as well as cleaning the `Monad` class from a
> > redundant method in the post-AMP world.
> >
> > A possible migration strategy is described further below.
> >
> >
> > Compatibility Considerations
> > ----------------------------
> >
> > Generalizing the type signature of a function from a `Monad`
> > constraint to its superclass `Applicative` doesn't cause new
> > type-errors in existing code.
> >
> > However, moving a method to a top-level binding obviously breaks code
> > that assumes `return` to be a class method. Foremost, code that
> > defines `Monad` instances it at risk:
> >
> > ### Instance Definitions
> >
> > Code defining `return` as part of an instance definition
> > breaks. However, we had the foresight to provide a default
> > implementation in `base-4.8` for `return` so that the following
> > represents a proper minimal instance definition post-AMP:
> >
> >
> >    instance Functor Foo where
> >        fmap g foo  = …
> >
> >    instance Applicative Foo where
> >        pure x      = …
> >        a1 <*> a2   = …
> >
> >    instance Monad Foo where
> >        m >>= f     = …
> >
> >        -- NB: No mention of `return`
> >
> >
> > Consequently, it is possible to write forward-compatible instances
> > that are valid under this proposal starting with GHC 7.10/`base-4.8`.
> >
> > Heuristically `grep`ing through Hackage source-code reveals a
> > non-negligible number of packages defining `Monad` instances with
> > explicit `return` definitions[4]. This has a comparable impact to the
> > AMP, and similarly will require a transition scheme aided by compiler
> > warnings.
> >
> > ### Module Import/Export Specifications
> >
> > A second source of incompatibility may be due to
> > `import`s. Specifically module import that assert `return` to be a
> > method of `Monad`, e.g.:
> >
> >    import Control.Monad  (Monad ((>>=), return))
> >
> > or
> >
> >    import Prelude hiding (Monad(..))
> >    import Control.Monad  (Monad(..)) as Monad
> >
> >    f = Monad.return ()
> >
> > The dual situation can occur when re-exporting `return` via module
> > export specifications.
> >
> > However, given that `return` is exported by `Prelude` and the examples
> > above are rather artificial, we don't expect this to be a major source
> > of breakage in the case of `return`. In fact, a heuristic grep[5] over
> > Hackage source-code revealed only 21 packages affected.
> >
> > ### Example for writing compatible code
> >
> >
> >    instance Functor Foo where
> >        fmap g foo  = …
> >
> >    instance Applicative Foo where
> >        pure x      = …
> >        a1 <*> a2   = …
> >
> >    instance Monad Foo where
> >        m >>= f     = …
> >
> >    #if !(MIN_VERSION_base(4,8,0))
> >        return = pure
> >    #endif
> >
> >
> > Migration Strategy
> > ------------------
> >
> > The migration strategy is straightforward:
> >
> > **Phase 1** *(GHC 8.0)*: Implement new warning in GHC which gets
> >   triggered when `Monad` instances explicitly override the
> >   default `return` method implementation.
> >
> > **Phase 2** *(GHC 8.2 or later)*: When we're confident that the
> >   majority of Hackage has reacted to the warning (with the help of
> >   Stackage actively pursuing maintainers to update their packages) we
> >   turn the `return` method into a top-level binding and remove the
> >   warning implemented in Phase 1 from GHC again.
> >
> >
> > Discussion period
> > -----------------
> >
> > A discussion period of three weeks (until 2015-10-15) should be enough
> > to allow everyone to chime in as well as leave enough time to make the
> > required preparations for GHC 8.0 should this proposal pass as we hope.
> >
> > ----
> >
> > [1]: https://wiki.haskell.org/Functor-Applicative-Monad_Proposal
> > [2]: https://wiki.haskell.org/MonadFail_Proposal
> > [3]: https://ghc.haskell.org/trac/ghc/wiki/ApplicativeDo
> > [4]: https://gist.github.com/hvr/b0e34463d85b58f169d9
> > [5]: https://gist.github.com/hvr/afcd040783d980594883
> > [6]: https://ghc.haskell.org/trac/ghc/ticket/9590
> > [7]:
> https://mail.haskell.org/pipermail/haskell-prime/2015-September/003936.html
> >
> > --
> > _______________________________________________
> > Libraries mailing list
> > Libraries at haskell.org
> > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20150928/8ca7da4d/attachment.html>


More information about the Libraries mailing list