是否可以概括这个 lmap

Question

我想概括一下二元函子lmap。

lmap 通常采用一个函数并将其映射到双函子中的左函子。

首先，我将概念推广Functor到类别之外(->)（这将帮助我们消除对Bifunctor类的需要）。

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)

我还需要一个，Flip以便我可以制作逆变函子和双函子。

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

现在我可以lmap通过将常规map提升为Flip：

lmap c = unflip . map c . Flip

这会翻转二元函子，应用贴图，然后将其翻转回来。这个问题现在却出现是Flip和unflip已经相当有限的类型。

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

这意味着当我得到类型

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

这里(->)inFlip和unflip强制我们的函子映射到(->)类别中。

当然，它们的内在没有任何东西使它们(->)的唯一范畴Flip可以被视为态射，例如有完全合理的定义

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)

等等。事实上，对于Category我能想到的每个实例，都有一个明确的任何简单的Flip. 但我显然无法构建Flip出(.)和id孤独。

因此我真的很想概括lmap为

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

这使它看起来更像map.

这可能吗？有什么办法可以实现这种类型还是我坚持(->)？

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)