haskell - 我应该如何遍历类型对齐的序列？

Question

去年夏天，我考虑了折叠类型对齐序列的概念，asking here如何实现 foldr 的类似物类似于foldMap 。约阿希姆·布莱特纳 (Joachim Breitner) 在一种棘手的新类型的帮助下做到了这一点。现在我决定考虑遍历类型对齐序列的概念。我第一个想到的是简单的翻译

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

索引 Atkey 式仿函数的多类版本。我实际上不需要任何代码的多重性，但我认为任何实际使用它的人都会期望它能够与各种幻像一起工作。此外，这给了我一个很好的借口来复制这里的定义以供引用:

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

类型对齐序列的可映射性概念，基于type-aligned中的方法:

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

我对类型对齐序列的可折叠性的概念:

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

迄今为止我对类型对齐序列的可遍历性的最佳概念:

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)

通过遍历来绘制 map 的机械:

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

<小时/>

我想我已经找到了落后根源的暗示。我的类型对齐列表从组合链的结束开始，这使得它与 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)