Proposal: Add default instances for Functor and Applicative
Maciej Marcin Piechotka
uzytkownik2 at gmail.com
Sat Sep 24 13:43:47 CEST 2011
On Sat, 2011-09-24 at 13:32 +0200, Bas van Dijk wrote:
> On 24 September 2011 12:49, Maciej Marcin Piechotka
> <uzytkownik2 at gmail.com> wrote:
> >> From what I understand (I haven't tried the extension yet) you would
> >> still need an instance declaration, even if it had no body:
> >>
> >> > instance Applicative List where
> >> > instance Functor List where
> >>
> >> to use the default methods.
> >>
> >> Antoine
> >
> > Withe the current implementation in GHC you wouldn't. At least the above
> > statement compiled fine (with full code in linked post).
>
> Are you sure?
>
> If I run the following code in GHC:
>
> ----------------------------------------------------------------------------------
> {-# LANGUAGE DefaultSignatures, NoImplicitPrelude #-}
>
> import Data.Function ((.), ($), const, id, flip)
> import Data.List (concatMap)
>
> class Functor f where
> fmap :: (a -> b) -> f a -> f b
> default fmap :: Applicative f => (a -> b) -> f a -> f b
> f `fmap` m = pure f <*> m
> (<$) :: a -> f b -> f a
> (<$) = fmap . const
>
> (<$>) :: Functor f => (a -> b) -> f a -> f b
> (<$>) = fmap
>
> class Functor f => Pointed f where
> point :: a -> f a
> default point :: Applicative f => a -> f a
> point = pure
>
> class Pointed f => Applicative f where
> pure :: a -> f a
> default pure :: Monad f => a -> f a
> pure = return
> (<*>) :: f (a -> b) -> f a -> f b
> default (<*>) :: Monad f => f (a -> b) -> f a -> f b
> f <*> v = liftM2 ($) f v
> (*>) :: f a -> f b -> f b
> (*>) = liftA2 (const id)
> (<*) :: f a -> f b -> f a
> (<*) = liftA2 const
>
> liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
> liftA2 f a b = f <$> a <*> b
>
> class Applicative f => Monad f where
> return :: a -> f a
> (>>=) :: f a -> (a -> f b) -> f b
> (>>) :: f a -> f b -> f b
> m >> k = m >>= const k
>
> liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
> liftM2 f m1 m2 = m1 >>= \x1 -> m2 >>= \x2 -> return (f x1 x2)
>
> instance Monad [] where
> return x = [x]
> (>>=) = flip concatMap
> ----------------------------------------------------------------------------------
>
> I get the expected:
>
> No instance for (Applicative [])
> arising from the superclasses of an instance declaration
> Possible fix: add an instance declaration for (Applicative [])
> In the instance declaration for `Monad []'
>
> Adding these fixes it:
>
> instance Applicative []
> instance Pointed []
> instance Functor []
>
> Regards,
>
> Bas
My error. I believed that complaining about missing main is the last
error reported by ghc (it turns out to be one of the first).
Regards
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: This is a digitally signed message part
URL: <http://www.haskell.org/pipermail/libraries/attachments/20110924/88b3c1ff/attachment.pgp>
More information about the Libraries
mailing list