haskell - 是否可以概括这个 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

这会翻转双仿函数，应用 map ，然后将其翻转回来。然而现在出现的问题是 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

这里 (->)在 Flip和 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)