Functor => Applicative => Monad
John Smith
voldermort at hotmail.com
Sun Dec 12 12:48:22 CET 2010
There's a ticket at http://trac.haskell.org/haskell-platform/ticket/155, and a wiki page at
http://haskell.org/haskellwiki/Functor-Applicative-Monad_Proposal.
Thanks for your patches!
On 12/12/2010 13:12, Bas van Dijk wrote:
> On Wed, Dec 1, 2010 at 10:02 AM, John Smith<voldermort at hotmail.com> wrote:
>> Regarding recent concerns as to whether Pointed is actually useful (and if
>> it is, is that Pointed Functors or pure Pointed?), how about a slightly more
>> modest reform?
>>
>> class Functor f where
>> map :: (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
>> (<*) :: f a -> f b -> f a
>>
>> class Applicative m => Monad m where
>> (>>=) :: m a -> (a -> m b) -> m b
>> f>>= x = join $ map f x
>>
>> join :: m (m a) -> m a
>> join x = x>>= id
>>
>> (unrelated, but also valid)
>>
>> instance MonadPlus m => Monoid (m a) where
>> mempty = mzero
>> mappend = mplus
>>
>>
>> module Legacy where
>>
>> fmap :: Functor f => (a -> b) -> f a -> f b
>> fmap = map
>>
>> liftA :: Applicative f => (a -> b) -> f a -> f b
>> liftA = map
>>
>> liftM :: Monad m => (a -> b) -> m a -> m b
>> liftM = map
>>
>> ap :: Monad m => m (a -> b) -> m a -> m b
>> ap = (<*>)
>>
>> (>>) :: Monad m => m a -> m b -> m b
>> (>>) = (*>)
>>
>> concat :: [[a]] -> [a]
>> concat = join
>>
>> etc.
>>
>> And for those who really want a list map,
>>
>> listMap :: (a -> b) -> [a] -> [b]
>> listMap = map
>>
>
> Linked are some patch bundles that provide an initial implementation
> of the new hierarchy:
>
> * http://code.haskell.org/~basvandijk/ghc_new_monad_hierarchy.dpatch
>
> This patch bundle is to prepare ghc for the new hierarchy. Most
> importantly it adds Functor and Applicative instances for all monads
> in ghc. Note that these patches are useful on their own and don't
> depend on the new hierarchy so they can be applied even when this
> proposal is not accepted.
>
> * http://code.haskell.org/~basvandijk/base_new_monad_hierarchy.dpatch
>
> This patch actually implements the new hierarchy. I tried to be even
> more conservative than the current proposal, namely 'return' and '>>'
> are still methods of Monad but have now been given default
> implementations in terms of Applicative. Also all names have been kept
> intact (fmap is still named fmap):
>
> 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
> (>>=) :: m a -> (a -> m b) -> m b
> m>>= f = join $ fmap f m
>
> join :: m (m a) -> m a
> join m = m>>= id
>
> (>>) :: m a -> m b -> m b
> (>>) = (*>)
>
> return :: a -> m a
> return = pure
>
> fail :: String -> m a
> fail s = error s
>
> Also see the generated library documentation:
>
> http://bifunctor.homelinux.net/~bas/doc/ghc/html/libraries/base-4.4.0.0/
>
> Note that I am in favour of removing 'return', '>>' and 'fail' from
> Monad and renaming 'fmap' to 'map'. But I think it's better to do this
> as a separate patch.
>
> Besides patching the base library and ghc, I also needed to patch lots
> of other libraries in my ghc root. To get these patches, simply pull
> from my local ghc repository. i.e.:
>
> darcs pull http://bifunctor.homelinux.net/~bas/ghc/
> darcs pull http://bifunctor.homelinux.net/~bas/ghc/libraries/base
>
> Note that ghc requires the happy parser generator. When happy
> generates a parser it also generates a HappyIdentity type with an
> according Monad instance. The following patch makes happy also
> generate the needed Functor and Applicative instances (This patch is
> already send to happy's maintainer):
>
> http://bifunctor.homelinux.net/~bas/functor_and_applicative_instance_HappyIdentity.dpatch
>
> Feel free to ask questions or post comments about these patches.
>
> Regards,
>
> Bas
>
> P.S.
> John, did you already make a ticket for this proposal? I would like to
> attach my patches to it.
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
More information about the Libraries
mailing list