barbies.hs

class FunctorB b where
  bmap :: forall f g. (Functor f, Functor g) => (forall a. f a -> g a) -> b f -> b g

instance {-# OVERLAPPABLE #-} (FunctorT (Flip t), FunctorB a) => FunctorB (t a) where
  bmap f a = runFlip $ tmap f $ Flip a

instance (FunctorT t, FunctorB a) => FunctorB (Flip t a) where
  bmap f a = Flip $ tmap f $ runFlip a

class FunctorT t where
  tmap :: forall f g x. (Functor f, Functor g, FunctorB x) => (forall a. f a -> g a) -> t f x -> t g x
  default tmap :: forall f g x. (Functor f, Functor g, FunctorB x) => (forall a. f a -> g a) -> t f x -> t g x
  tmap f a = runFlip $ bmap f $ Flip a