Is it possible to generalize this lmap

Question

I would like to generalize the bifunctor lmap a bit.

lmap normally takes a function and maps it across the left functor in a bifunctor.

To start I generalize the idea of Functor to categories beyond (->) (this will help us eliminate the need for a Bifunctor class).

class Category cat where
  id  :: cat a a
  (.) :: cat b c -> cat a b -> cat a c

instance Category (->) where
  id x = x
  (f . g) a = f (g a)

class (Category s, Category t) => Functor s t f where
  map :: s a b -> t (f a) (f b)

I also am going to need a Flip so that I can make contravariant functors, and bifunctors.

newtype Flip p a b =
  Flip
   { unflip :: p b a
   }

Now I can write my lmap by lifting a regular map up into Flip:

lmap c = unflip . map c . Flip

This flips the bifunctor, applies the map and then flips it back. The issue however now arises that Flip and unflip have rather restricted types.

Flip   :: p b a -> Flip p a b
unflip :: Flip p a b -> p b a

Which means when I get the type

lmap ::
  ( Functor s (->) (Flip p c)
  )
    => s a b -> p a c -> p b c

Here the (->) in Flip and unflip forces our functors to map into the (->) category.

Of course there is nothing inherent to these that makes (->) the only category of which Flip can be seen as a morphism, for example there are perfectly sensible definitions for

Flip :: Flip (->) (p a b) (Flip p b a)
Flip :: Monad m => Kleisli m (p a b) (Flip p b a)
Flip :: Monad m => Flip (Kleisli m) (p a b) (Flip p b a)

et cetera. In fact for every instance of Category I can think of there is a clear any easy instance of Flip. But I clearly can't build Flip out of (.) and id alone.

Thus I would really like to generalize lmap to

lmap ::
  ( Functor s t (Flip p c)
  )
    => s a b -> t (p a c) (p b c)

Which makes it look a lot more like map.

Is this possible? Is there someway that this type can be realized or am I stuck with (->)?

Answer 1

{-# LANGUAGE FlexibleInstances, FlexibleContexts
            , MultiParamTypeClasses, UndecidableInstances #-}

import qualified Prelude
import Control.Category.Constrained.Prelude
import Control.Arrow.Constrained
import Data.Type.Coercion

newtype Flip p a b = Flip { unflip :: p b a }

lmap :: ( Functor (Flip p c) s t
        , EnhancedCat s Coercion, EnhancedCat t Coercion
        , Object s a, Object s b
        , Object t (p a c), Object t (p c b), Object t (p b c)
        , Object t (Flip p c b), Object t (Flip p c a) )
         => s a b -> t (p a c) (p b c)
lmap c = flout Flip . fmap c . follow Flip

instance Prelude.Functor (Flip (,) a) where
  fmap f (Flip (x,y)) = Flip (f x,y)

instance Prelude.Monad m
   => Functor (Flip (,) a) (Kleisli m (->)) (Kleisli m (->))  where
  fmap (Kleisli f) = Kleisli $ \(Flip (x,y)) -> do
          x' <- f x
          return $ Flip (x',y)


main :: IO ()
main = do
  print $ lmap (+1) (0,0)
  t' <- runKleisli (lmap $ Kleisli print) (10,20)
  print t'
  return ()

(1,0)
10
((),20)