Как перемещаться по последовательностям, выровненным по типу?

Question

Прошлым летом я рассмотрел понятие складывания последовательности, выровненной по типу, asking here, как можно реализовать аналог foldr в терминах аналога foldMap. Иоахим Брейтнер смог сделать это с помощью сложного нового стиля. Теперь я решил подумать о понятии , пересекающем последовательность, выровненную по типу. Первая мысль, я был простой перевод

class TATraversable t where 
    ttraverse :: Applicative f 
      => (forall x y . c x y -> f (d x y)) 
      -> t c p q -> f (t d p q) 

, который оказывается в основном так же, как mapMThrist из thrist пакета. К сожалению, это, кажется, не быть достаточно сильным, чтобы реализовать

tfoldMap :: Category d 
     => (forall x y . c x y -> d x y) 
     -> f c p q -> d p q 

С момента Monoid в Foldable заменяется на Category для TAFoldable, тем Applicative из Traversable должен быть заменен чем-то сильнее. Я придумал следующее, основанное на индексированных аппликативных функциях, разработанных в стиле Atkey, но он чувствует себя немного неудобно, тем более, что индексы, похоже, хотят вернуться назад. В принципе, я просто бросил типы на стену, пока некоторые из них не застряли. Есть ли еще более принципиальный/понятный подход?

{-# LANGUAGE ScopedTypeVariables, RankNTypes, 
     GADTs, PolyKinds #-} 

module ITrav where 

--Not using this because it's not polykinded 
--import Data.Functor.Indexed 
import Control.Category 
import Prelude hiding (id, (.)) 

Поликидные версии индексированных функторов типа «Ацтек». Я действительно не нуждаюсь в полиподобности для любого из этого кода, но я думаю, что кто-то на самом деле , используя, будет ожидать, что он будет работать с фантомами всех видов. Кроме того, это дает мне хороший повод, чтобы скопировать определения здесь для справки:

class IxFunctor f where 
    imap :: (a -> b) -> f j k a -> f j k b 

class IxFunctor m => IxPointed m where 
    ireturn :: a -> m i i a 

class IxPointed m => IxApplicative m where 
    iap :: m i j (a -> b) -> m j k a -> m i k b 

Вводится понятие mappability для последовательностей типа выровнен, на основе метода в type-aligned:

class TAMappable t where 
    tmap :: (forall x y . c x y -> d x y) 
     -> t c p q -> t d p q 

Мое понятие foldability для последовательностей типа выровненных:

class TAFoldable f where 
    tfoldMap :: Category d 
      => (forall x y . c x y -> d x y) 
      -> f c p q -> d p q 

Мой лучший так далеко понятие traversability для последовательностей типа выровненных:

class (TAMappable t, TAFoldable t) => TATraversable t where 
    ttraverse :: IxApplicative m 
      => (forall x y . c x y -> m x y (d x y)) 
      -> t c p q -> m p q (t d p q) 

Машины для отображения путем обхода:

newtype Identity2 x y z = Identity2 {runIdentity2 :: z} 

instance IxFunctor Identity2 where 
    imap f (Identity2 x) = Identity2 (f x) 

instance IxPointed Identity2 where 
    ireturn = Identity2 

instance IxApplicative Identity2 where 
    iap (Identity2 f) (Identity2 x) = Identity2 (f x) 

tmapDefault :: TATraversable t => (forall x y . c x y -> d x y) -> t c p q -> t d p q 
tmapDefault f = runIdentity2 . ttraverse (Identity2 . f) 

Машины сложить путем обхода:

newtype Consty d x y z = Consty { getConsty :: d x y } 
instance IxFunctor (Consty d) where 
    imap _ (Consty x) = Consty x 
instance Category d => IxPointed (Consty d) where 
    ireturn _ = Consty id 
instance Category d => IxApplicative (Consty d) where 
    iap (Consty x) (Consty y) = Consty (y . x) 

tfoldMapDefault :: (Category d, TATraversable t) => (forall x y . c x y -> d x y) -> t c p q -> d p q 
tfoldMapDefault f = getConsty . ttraverse (Consty . f) 

Доказательство того, что по крайней мере, самый простой последовательности типа выровнен допускает (несколько странно) TATraversable экземпляр ,

infixr 5 ::: 
data TAL :: (k -> k -> *) -> k -> k -> * where 
    Nil :: TAL c x x 
    (:::) :: c y z -> TAL c x y -> TAL c x z 

instance TAMappable TAL where 
    tmap = tmapDefault 

instance TAFoldable TAL where 
    tfoldMap = tfoldMapDefault 

instance TATraversable TAL where 
    ttraverse _ Nil = ireturn Nil 
    ttraverse f (x ::: xs) = imap (flip (:::)) (ttraverse f xs) `iap` f x 

---

Я думаю, что я нашел намек на источник backwardsness. Мой список, выровненный по строкам, начинается с конца цепи композиции, что заставляет его бороться с порядком индекса IxApplicative.Одним из вариантов является заменить определение TAL выше

data TAL :: (k -> k -> *) -> k -> k -> * where 
    Nil :: TAL c x x 
    (:::) :: c x y -> TAL c y z -> TAL c x z 

, что делает очевидную работу экземпляра:

instance TATraversable TAL where 
    ttraverse _ Nil = ireturn Nil 
    ttraverse f (x ::: xs) = imap (:::) (f x) `iap` ttraverse f xs 

Но это вроде противный смотреть, если честно.

Answer 1

Я просто понял, один из способов сделать это: поменять местами индексы типа в определении ttraverse:

class (TAMappable t, TAFoldable t) => TATraversable t where 
    ttraverse :: IxApplicative m 
      => (forall x y . c x y -> m y x (d x y)) 
      -> t c p q -> m q p (t d p q) 

newtype Consty d y x z = Consty { getConsty :: d x y } 
instance Category d => IxApplicative (Consty d) where 
    iap (Consty x) (Consty y) = Consty (x . y) 

Тогда все работает так, как я первоначально был желавшим. Я не знаю, действительно ли это хорошая идея.

---

К счастью, кажется, что так или иначе я это делаю, я могу изменить, с аналогом Control.Applicative.Backwards.Backwards!

newtype IxBackwards m i j a = IxBackwards {ixForwards :: m j i a} 

instance IxFunctor f => IxFunctor (IxBackwards f) where 
    imap f (IxBackwards x) = IxBackwards (imap f x) 

instance IxPointed f => IxPointed (IxBackwards f) where 
    ireturn = IxBackwards . ireturn 

instance IxApplicative f => IxApplicative (IxBackwards f) where 
    iap (IxBackwards fs) (IxBackwards xs) = 
    IxBackwards $ imap (flip ($)) xs `iap` fs 

Порядок индексов в тип подписи ttraverse кажется, определяет порядок обхода. Пересекая IxBackwards будет, если я не очень смущен, обратный этот порядок:

traverseOpposite :: (IxApplicative m, TATraversable t) => (forall x y . c x y -> m x y (d x y)) -> t c p q -> m p q (t d p q) 
traverseOpposite f = ixForwards . ttraverse (IxBackwards . f)