是否可以将这个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

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