Why there is no way to derive Applicative Functors in Haskell?
Now that DerivingVia
has been released (GHC-8.6 or newer) it is actually possible to derive Applicative
with the help of DeriveGeneric
for any deterministic data type! That is to say, any data type with exactly one variant:
data Foo x = Foo x | Fe -- This is non-deterministic and can't derive Applicative
data Bar x = Bar x x (Bar x) -- This is deterministic and can derive Applicative
data Baz x = Baz (Either Int x) [x] -- This is also ok, since [] and Either Int
-- are both Applicative
data Void x -- This is not ok, since pure would be impossible to define.
To derive Applicative
, we first need to define a wrapper for deriving via generics:
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Generically1 where
import GHC.Generics
newtype Generically1 f x = Generically1 { generically1 :: f x }
fromg1 :: Generic1 f => Generically1 f a -> Rep1 f a
fromg1 = from1 . generically1
tog1 :: Generic1 f => Rep1 f x -> Generically1 f x
tog1 = Generically1 . to1
instance (Functor f, Generic1 f, Functor (Rep1 f))
=> Functor (Generically1 f) where
fmap f (Generically1 x) = Generically1 $ fmap f x
instance (Functor f, Generic1 f, Applicative (Rep1 f))
=> Applicative (Generically1 f) where
pure = tog1 . pure
f <*> x = tog1 $ fromg1 f <*> fromg1 x
instance (Functor f, Generic1 f, Monad (Rep1 f)) => Monad (Generically1 f) where
return = pure
m >>= f = tog1 $ fromg1 m >>= fromg1 . f
and to use it we first derive Generic1
for our data type and then derive Applicative
via our new Generically1
wrapper:
data Foo x = Foo x (Int -> x) (Foo x)
deriving (Functor, Generic1)
deriving (Applicative, Monad) via Generically1 Foo
data Bar x = Bar x (IO x)
deriving (Functor, Generic1)
deriving (Applicative, Monad) via Generically1 Bar
data Baz f x = Baz (f x) (f x)
deriving (Show, Functor, Generic1)
deriving (Applicative, Monad) via Generically1 (Baz f)
As you can see, we did not only derive Applicative
for our data types but could also derive Monad
.
The reason that this works is that there are instances for Applicative
and Monad
for the Generic1
representations of these data types. See for example the Product type (:*:). There is however no instance of Applicative
for the Sum type (:+:), which is why we can't derive it for non-deterministic types.
You can see the Generic1
representation of a data type by writing :kind! Rep1 Foo
in GHCi. Here are simplified versions (excluding meta-data) of the representations for the types above:
type family Simplify x where
Simplify (M1 i c f) = Simplify f
Simplify (f :+: g) = Simplify f :+: Simplify g
Simplify (f :*: g) = Simplify f :*: Simplify g
Simplify x = x
λ> :kind! Simplify (Rep1 Foo)
Simplify (Rep1 Foo) :: * -> *
= Par1 :*: (Rec1 ((->) Int) :*: Rec1 Foo)
λ> :kind! Simplify (Rep1 Bar)
Simplify (Rep1 Bar) :: * -> *
= Par1 :*: Rec1 IO
λ> :kind! forall f. Simplify (Rep1 (Baz f))
forall f. Simplify (Rep1 (Baz f)) :: k -> *
= forall (f :: k -> *). Rec1 f :*: Rec1 f
Edit: The Generically1
wrapper is also available here: https://hackage.haskell.org/package/generic-data-0.7.0.0/docs/Generic-Data.html#t:Generically1
No, this is not obvious at all. Compare the following Applicative
instances:
[]
ZipList
Data.Sequence.Seq
, whoseApplicative
instance declaration runs to several hundred lines.IO
(->) r
- Parsers in
parsec
,attoparsec
,regex-applicative
. - Proxy in the
pipes
package.
There very little uniformity here, and most of the instances are non-obvious.
As David Young comments, the []
and ZipList
instances "are both, ultimately, two different, equally valid Applicative
instances for the list type."