Inflexible DerivingVia
Summary
I recently wanted to derive instances like Functor
and Applicative
for a datatype that has an Arrow
instance. I thought this would be possible by deriving via the ArrowMonad
type. Unfortunately this doesn't work.
Steps to reproduce
Here is a minimal reproducer:
{-# LANGUAGE DerivingVia #-}
import Control.Arrow
import Control.Category
data Test a b = Test a b
deriving Functor via ArrowMonad Test
-- details of these instances don't matter
instance Category Test
instance Arrow Test
This gives two related errors:
Sad.hs:6:35: error:
• Couldn't match representation of type ‘a’ with that of ‘()’
arising from the coercion of the method ‘<$’
from type ‘forall a b. a -> ArrowMonad Test b -> ArrowMonad Test a’
to type ‘forall a1 b. a1 -> Test a b -> Test a a1’
‘a’ is a rigid type variable bound by
the deriving clause for ‘Functor (Test a)’
at Sad.hs:6:35-41
• When deriving the instance for (Functor (Test a))
|
6 | data Test a b = Test a b deriving Functor via ArrowMonad Test
| ^^^^^^^
Sad.hs:6:35: error:
• Couldn't match representation of type ‘a’ with that of ‘()’
arising from the coercion of the method ‘fmap’
from type ‘forall a b.
(a -> b) -> ArrowMonad Test a -> ArrowMonad Test b’
to type ‘forall a1 b. (a1 -> b) -> Test a a1 -> Test a b’
‘a’ is a rigid type variable bound by
the deriving clause for ‘Functor (Test a)’
at Sad.hs:6:35-41
• When deriving the instance for (Functor (Test a))
|
6 | data Test a b = Test a b deriving Functor via ArrowMonad Test
| ^^^^^^^
Expected behavior
It does kind of make sense, but I hoped the deriving mechanism would generate instances like this:
instance Functor (Test ()) where
fmap :: forall a b. (a -> b) -> Test () a -> Test () b
fmap = coerce (fmap @(ArrowMonad Test) @a @b)
The Test ()
could be inferred from the definition of ArrowMonad
, namely:
newtype ArrowMonad a b = ArrowMonad (a () b)
So ArrowMonad Test a
has the same representation as Test () a
.
I guess I don't really know if this is a bug or a feature request because this instance does require FlexibleInstances
which might complicate things.
Workaround
A workaround is to use standalone deriving, but that can get verbose, this is an example from a parser arrow and monad that I'm working on:
newtype Parser a b = Parser { unParser :: (a, String) -> Steps (b, String) }
deriving (Category, Arrow, ArrowZero, ArrowPlus, ArrowChoice, ArrowApply)
via StateArrow String (Kleisli Steps)
deriving via ArrowMonad Parser instance Functor (Parser ())
deriving via ArrowMonad Parser instance Applicative (Parser ())
deriving via ArrowMonad Parser instance Alternative (Parser ())
deriving via ArrowMonad Parser instance Monad (Parser ())
deriving via ArrowMonad Parser instance MonadPlus (Parser ())
Another alternative is to change ArrowMonad
to expose another type parameter:
newtype ArrowMonad' a b c = ArrowMonad' (a b c)
(only the Monad
instance needs a small change)
Then I could write:
newtype Parser a b = Parser { unParser :: (a, String) -> Steps (b, String) }
deriving (Category, Arrow, ArrowZero, ArrowPlus, ArrowChoice, ArrowApply)
via StateArrow String (Kleisli Steps)
deriving (Functor, Applicative, Alternative, Monad, MonadPlus)
via ArrowMonad' Parser a
Environment
- GHC version used: 8.10.4
Optional:
- Operating System: NixOS 21.05
- System Architecture: x86_64