[Haskell-cafe] {-# LANGUAGE DeriveApplicative #-} ?

Ben Millwood haskell at benmachine.co.uk
Thu May 6 06:53:40 EDT 2010


On Thu, May 6, 2010 at 8:55 AM, Pavel Perikov <perikov at gmail.com> wrote:
> Hi, list!.
>
> Now in 6.12.1 we have DeriveFunctor, DeriveFoldable and DeriveTraversable. This greatly simplifies the "reuse structure" style of programming. Some structure (not just _data_ structure) got captured in ADT and can be reused for various purposes.
>
> Wouldn't it be nice to have the ability to derive Applicative as well? It shouldn't be more difficult than deriving Functor but will provide exciting possibilities. Just think about liftA2.
>

The difference is that there is at most one law-abiding instance of
Functor for each type, whereas there are in principle multiple
possible instances for Applicative for a type. E.g. the following:

instance Applicative [] where
 pure x = [x]
 fs <*> xs = concatMap (\f -> map f xs) fs

instance Applicative [] where
 pure = repeat
 (f:fs) <*> (x:xs) = f x : fs <*> xs
 _ <*> _ = []

are both law-abiding instances (although only one has a corresponding
law-abiding Monad, I believe). Which should GHC choose?
It's worth noting, though, that there are other derivable classes that
don't have a single implementation. It's a question of trading off
complexity of the compiler versus saved effort in code versus
additional clarity in code, I think.


More information about the Haskell-Cafe mailing list