Proposal: Applicative => Monad: Call for consensus
John Smith
voldermort at hotmail.com
Tue Jan 4 08:15:07 CET 2011
Thanks for the detailed clarification, I've copied this message to the wiki page
On 04/01/2011 00:30, Bas van Dijk wrote:
> The patch for base makes a few changes:
>
> 1) Make Applicative a superclass of Monad. So the new hierarchy becomes:
>
> class Functor f where
> fmap :: (a -> b) -> f a -> f b
>
> (<$) :: a -> f b -> f a
> (<$) = fmap . const
>
> class Functor f => Applicative f where
> pure :: a -> f a
>
> (<*>) :: f (a -> b) -> f a -> f b
>
> (*>) :: f a -> f b -> f b
> a *> b = fmap (const id) a<*> b
>
> (<*) :: f a -> f b -> f a
> a<* b = fmap const a<*> b
>
> class Applicative m => Monad m where
> (>>=) :: forall a b. m a -> (a -> m b) -> m b
> m>>= f = join $ fmap f m
>
> join :: m (m a) -> m a
> join m = m>>= id
>
> (>>) :: forall a b. m a -> m b -> m b
> (>>) = (*>)
>
> return :: a -> m a
> return = pure
>
> fail :: String -> m a
> fail s = error s
>
> 2) Make 'join' a method of Monad.
>
> 3) Export Applicative(pure, (<*>), (*>), (<*)) from the Prelude.
> (Maybe we shouldn't export the (*>) and (<*) methods.)
>
> 4) Also export the join method from the Prelude.
>
> 5) Add Applicative instances for all monads in base.
>
> 6) Add a Monad instance for ((,) a): (There are already Functor and
> Applicative instances for it.)
>
> instance Monoid a => Monad ((,) a) where
> (u, x)>>= f = let (v, y) = f x
> in (u `mappend` v, y)
>
> (Maybe this one should be left out of the patch)
>
> The patch for ghc simply adds Applicative instances for all monads in
> ghc. Also included in the ghc patch bundle are some refactoring
> patches that will make the transition easier:
>
> * Added (<>) = mappend to compiler/utils/Util.hs.
> * Add a Monoid instance for AGraph and remove the<*> splice operator.
> Instead of<*>, the (<>) = mappend operator is now used to splice AGraphs.
> This change is needed because<*> clashes with the Applicative apply
> operator<*>, which is probably going to be exported from the Prelude
> when the new Monad hierarchy is going through. (Simply hiding<*> from
> the Prelude is also possible of course. However, I think this makes
> things easier to understand)
> * Make SDoc an abstract newtype and add a Monoid instance for it.
> The (<>) combinator of SDocs is removed and replaced by the more
> general (<>) = mappend combinator from Util.
>
> Note that all the ghc patches can be applied independently of the base patch.
>
> Now which notable things are not included in the patch for base:
>
> * fmap is not renamed to map.
> * return and (>>) are not removed as a method.
> * fail is not removed as a method.
> * All the liftM functions are not removed in favour of fmap and liftAs.
>
> I think these are better left as separate proposals.
>
> Regards,
>
> Bas
More information about the Libraries
mailing list