是否可以懒惰地获取 Traversable 的所有上下文？

Question

lens 提供 holesOf，这是这个假设函数的更通用和更强大的版本：

holesList :: Traversable t
          => t a -> [(a, a -> t a)]

给定一个容器，holesList 生成容器元素列表以及用于替换这些元素的函数。

holesList 的类型与真实 holesOf 的类型一样，未能捕捉到生成的对数将等于容器元素数的事实。因此，一个更漂亮的类型是

holes :: Traversable t
      => t a -> t (a, a -> t a)

我们可以通过使用 holesList 制作一个列表然后遍历 State 将元素吸回来来实现 holes。但这并不令人满意，原因有二，其中之一这具有实际后果：

slurping 代码将有一个无法访问的错误调用来处理列表在遍历完成之前运行为空的情况。这很恶心，但对于使用该功能的人来说可能并不重要。
向左无限延伸的容器，或向左底部伸出的容器，根本无法工作。向左延伸很远的容器处理起来效率很低。

我想知道是否有解决这些问题的方法。很可能在 lens:

中使用 Magma 之类的东西来捕捉遍历的形状

data FT a r where
  Pure :: r -> FT a r
  Single :: a -> FT a a
  Map :: (r -> s) -> FT a r -> FT a s
  Ap :: FT a (r -> s) -> FT a r -> FT a s

instance Functor (FT a) where
  fmap = Map
instance Applicative (FT a) where
  pure = Pure
  (<*>) = Ap

runFT :: FT a t -> t
runFT (Pure t) = t
runFT (Single a) = a
runFT (Map f x) = f (runFT x)
runFT (Ap fs xs) = runFT fs (runFT xs)

现在我们有

runFT . traverse Single = id

traverse Single 使树充满元素以及将它们构建到容器中所需的功能应用程序。如果我们替换树中的一个元素，我们可以 runFT 结果得到一个替换了该元素的容器。不幸的是，我被困住了：我不知道下一步会是什么样子。

模糊的想法：添加另一个类型参数可能有助于更改元素类型。 Magma 类型做类似的事情，它至少可以追溯到 Zemyla 在 Van Laarhoven 的博客 post 上关于 FunList.

的评论

Answer 1

我还没有找到一种非常漂亮的方法来做到这一点。那可能是因为我不够聪明，但我怀疑这是 traverse 类型的固有限制。但是我找到了一个有点丑陋的方法！关键确实似乎是 Magma 使用的额外类型参数，它让我们可以自由地构建一个需要特定元素类型的框架，然后在以后填充元素。

data Mag a b t where
  Pure :: t -> Mag a b t
  Map :: (x -> t) -> Mag a b x -> Mag a b t
  Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
  One :: a -> Mag a b b

instance Functor (Mag a b) where
  fmap = Map

instance Applicative (Mag a b) where
  pure = Pure
  (<*>) = Ap

-- We only ever call this with id, so the extra generality
-- may be silly.
runMag :: forall a b t. (a -> b) -> Mag a b t -> t
runMag f = go
  where
    go :: forall u. Mag a b u -> u
    go (Pure t) = t
    go (One a) = f a
    go (Map f x) = f (go x)
    go (Ap fs xs) = go fs (go xs)

我们使用 Mag a a (t a) 类型之一并行递归下降类型 Mag x (a, a -> t a) (t (a, a -> t a)) 的值，使用后者产生 a 和 a -> t a 值，前者作为从这些值构建 t (a, a -> t) 的框架。 x 实际上是 a；它保留了多态性，使 "type tetris" 不那么混乱。

-- Precondition: the arguments should actually be the same;
-- only their types will differ. This justifies the impossibility
-- of non-matching constructors.
smash :: forall a x t u.
         Mag x (a, a -> t) u
      -> Mag a a t
      -> u
smash = go id
  where
    go :: forall r b.
          (r -> t)
       -> Mag x (a, a -> t) b
       -> Mag a a r
       -> b
    go f (Pure x) _ = x
    go f (One x) (One y) = (y, f)
    go f (Map g x) (Map h y) = g (go (f . h) x y)
    go f (Ap fs xs) (Ap gs ys) =
      (go (f . ($ runMag id ys)) fs gs)
      (go (f . runMag id gs) xs ys)
    go _ _ _ = error "Impossible!"

我们实际上使用对 traverse 的一次调用生成两个 Mag 个值（不同类型！）。这两个值实际上将由内存中的单个结构表示。

holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes t = smash mag mag
  where
    mag :: Mag a b (t b)
    mag = traverse One t

现在我们可以玩一些有趣的值了，比如

holes (Reverse [1..])

其中 Reverse 来自 Data.Functor.Reverse.

Answer 2

Your existing solution 为 Ap 构造函数定义的树中的每个分支调用一次 runMag。

我没有分析任何东西，但由于 runMag 本身是递归的，这可能会降低大树的速度。

另一种方法是打结，这样您（实际上）只为整棵树调用 runMag 一次：

data Mag a b c where
  One :: a -> Mag a b b
  Pure :: c -> Mag a b c
  Ap :: Mag a b (c -> d) -> Mag a b c -> Mag a b d

instance Functor (Mag a b) where
  fmap = Ap . Pure

instance Applicative (Mag a b) where
  pure = Pure
  (<*>) = Ap

holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes = \t -> 
    let m :: Mag a b (t b)
        m = traverse One t 
    in fst $ go id m m
  where
    go :: (x -> y)
       -> Mag a (a, a -> y) z
       -> Mag a a x
       -> (z, x)
    go f (One a)    (One _)    = ((a, f), a)
    go _ (Pure z)   (Pure x)   = (z, x)
    go f (Ap mg mi) (Ap mh mj) = 
      let ~(g, h) = go (f . ($j)) mg mh
          ~(i, j) = go (f .   h ) mi mj
      in (g i, h j)
    go _ _ _ = error "only called with same value twice, constructors must match"

Answer 3

这是一个简短、完整（如果忽略循环性）、不使用任何中间数据结构且惰性（适用于任何类型的无限可遍历）的实现：

import Control.Applicative
import Data.Traversable

holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runKA id $ for t $ \a ->
  KA $ \k ->
    let f a' = fst <$> k (a', f)
    in (a, f)

newtype KA r a = KA { runKA :: (a -> r) -> a }

instance Functor (KA r) where fmap f a = pure f <*> a
instance Applicative (KA r) where
  pure a = KA (\_ -> a)
  liftA2 f (KA ka) (KA kb) = KA $ \cr ->
    let
      a = ka ar
      b = kb br
      ar a' = cr $ f a' b
      br b' = cr $ f a b'
    in f a b

KA 是一个 "lazy continuation applicative functor"。如果我们用标准的 Cont monad 替换它，我们也会得到一个可行的解决方案，但它不是惰性的，但是：

import Control.Monad.Cont
import Data.Traversable

holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runCont id $ for t $ \a ->
  cont $ \k ->
    let f a' = fst <$> k (a', f)
    in k (a, f)

Answer 4

这并没有真正回答原来的问题，但它显示了另一个角度。看起来这个问题实际上与我问的关系很深。假设 Traversable 有一个额外的方法：

traverse2 :: Biapplicative f
           => (a -> f b c) -> t a -> f (t b) (t c)

注意：实际上可以为任何具体的 Traversable 数据类型合法地实现此方法。对于像

这样的怪人

newtype T a = T (forall f b. Applicative f => (a -> f b) -> f (T b))

查看链接问题答案中的非法方式。

有了它，我们可以设计一个与 Roman 的非常相似的类型，但与 rampion 的不同：

newtype Holes t m x = Holes { runHoles :: (x -> t) -> (m, x) }

instance Bifunctor (Holes t) where
  bimap f g xs = Holes $ \xt ->
    let
      (qf, qv) = runHoles xs (xt . g)
    in (f qf, g qv)

instance Biapplicative (Holes t) where
  bipure x y = Holes $ \_ -> (x, y)
  fs <<*>> xs = Holes $ \xt ->
    let
      (pf, pv) = runHoles fs (\cd -> xt (cd qv))
      (qf, qv) = runHoles xs (\c -> xt (pv c))
    in (pf qf, pv qv)

现在一切都变得简单了：

holedOne :: a -> Holes (t a) (a, a -> t a) a
holedOne x = Holes $ \xt -> ((x, xt), x)

holed :: Traversable t => t a -> t (a, a -> t a)
holed xs = fst (runHoles (traverse2 holedOne xs) id)

是否可以懒惰地获取 Traversable 的所有上下文？

Is it possible to get all contexts of a Traversable lazily?

haskell

haskell-lens

traversable