Last active
October 7, 2019 23:04
-
-
Save kcsongor/a8cb718f676c6ca1d999bfc56def9b7b to your computer and use it in GitHub Desktop.
Derive Bifunctor with GHC.Generics
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# 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) |
Oops, you're right, thanks!
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
You're missing at least a couple of instances. The ones I found was the case like this:
Adding these instances fixes it: