Можно ли обобщить этот lmap - PullRequest
Новая
       90

Можно ли обобщить этот lmap

6 голосов
/ 04 мая 2020

Я хотел бы немного обобщить бифунктор 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

Это переворачивает bifunctor, применяет карту и затем переворачивает ее. Однако теперь возникает проблема, что 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

Здесь (->) in 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.

Возможно ли это? Есть ли какой-то способ реализовать этот тип или я застрял с (->)?

1 Ответ

2 голосов
/ 04 мая 2020 
{-# LANGUAGE FlexibleInstances, FlexibleContexts
            , MultiParamTypeClasses, UndecidableInstances #-}

import qualified Prelude
import <a href="http://hackage.haskell.org/package/constrained-categories-0.4.0.0/docs/Control-Category-Constrained-Prelude.html" rel="nofollow noreferrer">Control.Category.Constrained.Prelude</a>
import <a href="http://hackage.haskell.org/package/constrained-categories-0.4.0.0/docs/Control-Arrow-Constrained.html" rel="nofollow noreferrer">Control.Arrow.Constrained</a>
import <a href="https://hackage.haskell.org/package/base-4.14.0.0/docs/Data-Type-Coercion.html" rel="nofollow noreferrer">Data.Type.Coercion</a>

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)
...