Derive Bifunctor with GHC.Generics
{-# LANGUAGE DefaultSignatures #-} | |
{-# LANGUAGE DeriveAnyClass #-} | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE StandaloneDeriving #-} | |
{-# LANGUAGE TypeOperators #-} | |
module Bifunctor where | |
import GHC.Generics | |
class Bifunctor p where | |
bimap :: (a -> b) -> (c -> d) -> p a c -> p b d | |
default bimap | |
:: ( Generic (p a c) | |
, Generic (p b d) | |
, GBifunctor (Rep (p a c)) (Rep (p b d)) a b c d | |
) => (a -> b) -> (c -> d) -> p a c -> p b d | |
bimap f g = to . gbimap f g . from | |
deriving instance Bifunctor Either | |
data T a b = T1 (Maybe a) a (Either a b) | T2 (Maybe b) | |
deriving (Generic, Bifunctor) | |
-------------------------------------------------------------------------------- | |
class GBifunctor s t a b c d where | |
gbimap :: (a -> b) -> (c -> d) -> s x -> t x | |
instance GBifunctor s t a b c d => GBifunctor (M1 k m s) (M1 k m t) a b c d where | |
gbimap f g = M1 . gbimap f g . unM1 | |
instance (GBifunctor l l' a b c d, GBifunctor r r' a b c d) => GBifunctor (l :+: r) (l' :+: r') a b c d where | |
gbimap f g (L1 l) = L1 (gbimap f g l) | |
gbimap f g (R1 r) = R1 (gbimap f g r) | |
instance GBifunctor U1 U1 a b c d where | |
gbimap _ _ = id | |
instance (GBifunctor l l' a b c d, GBifunctor r r' a b c d) => GBifunctor (l :*: r) (l' :*: r') a b c d where | |
gbimap f g (l :*: r) = gbimap f g l :*: gbimap f g r | |
instance {-# INCOHERENT #-} GBifunctor (Rec0 a) (Rec0 b) a b c d where | |
gbimap f _ (K1 a) = K1 (f a) | |
instance {-# INCOHERENT #-} GBifunctor (Rec0 c) (Rec0 d) a b c d where | |
gbimap _ g (K1 a) = K1 (g a) | |
instance {-# INCOHERENT #-} GBifunctor (Rec0 x) (Rec0 x) a b c d where | |
gbimap _ _ = id | |
-- These instances look through wrapped functors and bifunctors. | |
instance {-# INCOHERENT #-} Bifunctor f => GBifunctor (Rec0 (f a c)) (Rec0 (f b d)) a b c d where | |
gbimap f g (K1 a) = K1 (bimap f g a) | |
instance {-# INCOHERENT #-} Functor f => GBifunctor (Rec0 (f c)) (Rec0 (f d)) a b c d where | |
gbimap _ g (K1 a) = K1 (fmap g a) | |
instance {-# INCOHERENT #-} Functor f => GBifunctor (Rec0 (f a)) (Rec0 (f b)) a b c d where | |
gbimap f _ (K1 a) = K1 (fmap f a) | |
instance {-# INCOHERENT #-} Bifunctor f => GBifunctor (Rec0 (f a a)) (Rec0 (f b b)) a b c d where | |
gbimap f _ (K1 a) = K1 (bimap f f a) | |
instance {-# INCOHERENT #-} Bifunctor f => GBifunctor (Rec0 (f c c)) (Rec0 (f d d)) a b c d where | |
gbimap _ g (K1 b) = K1 (bimap g g b) |
This comment has been minimized.
This comment has been minimized.
Oops, you're right, thanks! |
This comment has been minimized.
This comment has been minimized.
instance GBifunctor V1 V1 a b c d where
gbimap _ _ = id In principle, we actually have instance GBifunctor s U1 a b c d where
gbimap _ _ _ = U1
instance GBifunctor V1 t a b c d where
gbimap _ _ x = case x of but that's probably not useful in context and I don't know how it might affect instance resolution. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This comment has been minimized.
You're missing at least a couple of instances. The ones I found was the case like this:
Adding these instances fixes it: