提升一个（镜头）遍历来修复

Question

我有以下代码。如您所见，最后一个函数是 undefined.

{-# LANGUAGE TemplateHaskell, DeriveFunctor, DeriveTraversable #-}

module Example where

import Control.Lens
import Data.Functor.Foldable

data PathComponent d a = Directions d | Alt [a] deriving (Show, Functor, Foldable, Traversable)

makePrisms ''PathComponent

newtype Path d a = Path [PathComponent d a] deriving (Show, Functor, Foldable, Traversable)

directions :: Traversal (Path a p) (Path b p) a b
directions a2fb (Path l) = Path <$> traverse f l where
    f (Directions d) = Directions <$> a2fb d
    f (Alt p) = (pure . Alt) p

directions' :: Traversal (Fix (Path a)) (Fix (Path b)) a b
directions' = undefined

我最终想要做的是在结构中递归地将每个 a 映射到一个 b。我希望我可以通过提升 directions 来做到这一点，但我似乎被 a) 函数在 s 和 t 位置声明 p 的事实以及b) _Wrapping 是 Iso' 而不是 Iso 这一事实。有解决这个问题的优雅方法吗？

Answer 1

在directions中我们也需要用a2fb遍历p。既然p是一个参数，我们就可以把它的遍历作为参数。另外，你定义的f其实就是对PathComponent的遍历，我们也可以把它拉出来。

首先，PathComponent a p 的遍历，它由 p 的遍历参数化（并且被泛化，因此源和目标类型可以不同）：

data PathComponent d a = Directions d | Alt [a] deriving (Show, Functor, Foldable, Traversable)

{- Morally

traversePC ::
  Traversal pa pb a b ->
  Traversal (PathComponent a pa) (PathComponent b pb) a b

   But the following type is both simpler (rank 1) and more general.
-}
traversePC ::
  Applicative m =>
  LensLike m pa pb a b ->
  LensLike m (PathComponent a pa) (PathComponent b pb) a b
traversePC _tp f (Directions d) = Directions <$> f d
traversePC  tp f (Alt pas) = Alt <$> (traverse . tp) f pas

在Directions的情况下，我们直接将a转换为b。在 Alt 的情况下，我们有一个 pa 的列表，所以我们用参数 traversal (tp).[=46 组成该列表 (traverse) 的遍历=]

遍历Path从tp到traversePC。

newtype Path d a = Path [PathComponent d a] deriving (Show, Functor, Foldable, Traversable)

{- Same idea about the types.

directions :: Traversal pa pb a b -> Traversal (Path a pa) (Path b pb) a b

-}

directions ::
  Applicative m =>
  LensLike m pa pb a b ->
  LensLike m (Path a pa) (Path b pb) a b
directions tp f (Path l) = Path <$> (traverse . traversePC tp) f l

最后，为了遍历 Fix (Path a)，解包为 h :: Path a (Fix (Path a))，我们递归地向下传递 Fix (Path a) 的顶层遍历。

directions' :: Traversal (Fix (Path a)) (Fix (Path b)) a b
directions' f (Fix h) = Fix <$> directions directions' f h

事实上，对于任何 Fix，这里都有一个通用模式。如果你有一个函子f（这里是Path a），并且有一个f x的遍历被x的遍历参数化，那么你可以打个结得到一个Fix f 的遍历 traverseFix'，将参数化遍历应用于 traverseFix' 本身。

{-

traverseFix ::
  (forall x y. Traversal x y a b -> Traversal (f x) (g y) a b) ->
  Traversal (Fix f) (Fix g) a b

-}

traverseFix ::
  Functor m =>
  (forall x y. LensLike m x y a b -> LensLike m (f x) (g y) a b) ->
  LensLike m (Fix f) (Fix g) a b
traverseFix traverseF = traverseFix' where
  traverseFix' f (Fix h) = Fix <$> traverseF traverseFix' f h

所以我们可以重新定义directions'如下：

directions'' :: Traversal (Fix (Path a)) (Fix (Path b)) a b
directions'' = traverseFix directions

Full gist

提升一个（镜头）遍历来修复

Lifting a (Lens) Traversal to Fix

haskell

haskell-lens