当我的 getter 和 setter 返回“Either”时，我可以构建类似镜头的东西吗？

Question

简述

我的 getter 和 setter 都可能失败，并带有描述如何的消息。因此他们返回Either String，这意味着我不能以正常方式用它们制作镜片。

详细说明

考虑这些类型：

import qualified Data.Vector as V

data Tree a = Tree { label :: a
                   , children :: V.Vector (Tree a) }

type Path = [Int]

并非每个Path 到Tree 都会导致Tree，因此getter 必须具有类似getSubtree :: Path -> Tree a -> Either String (Tree a) 的签名。一个 setter 需要一个类似的签名（见下面的modSubtree）。

如果 getter 和 setter 返回 Tree a 类型的值，我会使用它们来创建镜头，通过类似于 Lens.Micro 中的 lens 函数。但是，如果他们返回Either，我就不能这样做。所以我不能用其他镜头来组合它们，所以我必须做很多包装和展开。

有什么更好的方法？

示例代码

{-# LANGUAGE ScopedTypeVariables #-}

module I_wish_I_could_lens_this_Either where

import qualified Data.Vector as V

data Tree a = Tree { label :: a
                   , children :: V.Vector (Tree a) }
              deriving (Show, Eq, Ord)

type Path = [Int]

-- | This is too complicated.
modSubtree :: forall a. Show a =>
  Path -> (Tree a -> Tree a) -> Tree a -> Either String (Tree a)
modSubtree [] f t = Right $ f t
modSubtree (link:path) f t = do
  if not $ inBounds (children t) link
    then Left $ show link ++ "is out of bounds in " ++ show t
    else Right ()
  let (cs :: V.Vector (Tree a)) = children t
      (c :: Tree a) = cs V.! link
  c' <- modSubtree path f c
  cs' <- let left = Left "imossible -- link inBounds already checked"
         in maybe left Right $ modifyVectorAt link (const c') cs
  Right $ t {children = cs'}

getSubtree :: Show a => Path -> Tree a -> Either String (Tree a)
getSubtree [] t = Right t
getSubtree (link:path) t =
  if not $ inBounds (children t) link
  then Left $ show link ++ "is out of bounds in " ++ show t
  else getSubtree path $ children t V.! link

-- | check that an index into a vector is inbounds
inBounds :: V.Vector a -> Int -> Bool
inBounds v i = i >= 0 &&
               i <= V.length v - 1

-- | Change the value at an index in a vector.
-- (Data.Vector.Mutable offers a better way.)
modifyVectorAt :: Int -> (a -> a) -> V.Vector a -> Maybe (V.Vector a)
modifyVectorAt i f v
  | not $ inBounds v i = Nothing
  | otherwise = Just ( before
                       V.++ V.singleton (f $ v V.! i)
                       V.++ after )
    where before = V.take i v
          after = V.reverse $ V.take remaining $ V.reverse v
            where remaining = (V.length v - 1) - i

Answer 1

你确实可以用镜头做到这一点！或者更具体地说；遍历:)

首先进行一些设置：

{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
module TreeTraversal where

import qualified Data.Vector as V
import Control.Lens hiding (children)

data Tree a = Tree { _label :: a
                   , _children :: V.Vector (Tree a) }
              deriving (Show, Eq, Ord, Functor)
makeLenses ''Tree
type Path = [Int]

从这一点开始，有两种方法可以继续；如果您只需要知道整个遍历是否成功（例如路径中的任何链接都无法访问），那么您可以使用failover；它需要一个遍历和一个函数，并将尝试在遍历上运行该函数，但它将在Alternative 上下文中返回结果；我们可以将此上下文选择为“可能”，以便我们可以通过模式匹配检测失败并返回适当的Left 或Right。我不知道遍历索引列表的简单方法，因此我编写了一个快速帮助程序来递归链接列表并将它们转换为使用组合的遍历。

modSubtreeWithGenericError
    :: forall a. Show a
    => Path -> (Tree a -> Tree a) -> Tree a -> Either String (Tree a)
modSubtreeWithGenericError links f =
    maybe (Left "out of bounds") Right . failover (pathOf links) f
  where
    pathOf :: [Int] -> Traversal' (Tree a) (Tree a)
    pathOf [] = id
    pathOf (p : ps) = children . ix p . pathOf ps

如果您只关心一般的失败，那应该可以解决问题，但是很高兴知道它在哪里失败了，对吧？我们可以通过编写一个自定义遍历来做到这一点，该遍历知道它在 Either String 内部运行；大多数遍历必须在任何应用程序上工作，但在我们的例子中，我们知道我们希望我们的结果在 Either 中；所以我们可以利用这一点：

modSubtreeWithExpressiveError
    :: forall a. Show a
    => [Int] -> (Tree a -> Tree a) -> Tree a -> Either String (Tree a)
modSubtreeWithExpressiveError links f = pathOf links %%~ (pure . f)
  where
    pathOf :: [Int] -> LensLike' (Either String) (Tree a) (Tree a)
    pathOf [] = id
    pathOf (x : xs) = childOrFail x . pathOf xs
    childOrFail :: Show a => Int -> LensLike' (Either String) (Tree a) (Tree a)
    childOrFail link f t =
        if t & has (children . ix link)
           then t & children . ix link %%~ f
           else buildError link t

childOrFail 很有趣； LensLike 位实际上只是 (Tree a -> Either String (Tree a)) -> Tree a -> Either String (Tree a) 的别名，它只是 traverse 专用于 Either String；我们不能直接使用traverse，因为我们只想遍历单个子树，并且我们的函数在Tree a 上运行，而不仅仅是a。我手动编写了遍历，首先使用has检查目标是否存在，然后使用Left失败并出现一个很好的错误，或者在适当的孩子上运行f（代表遍历的其余部分）使用%%~。 %%~ 组合器也有点吓人；具有讽刺意味的是，它的定义实际上是(%%~) = id；通常我们会在这里使用%~；但它需要一个与我们指定的 Either String 不匹配的特定 Applicative。 %%~ 愉快地运行我们的自定义遍历，尽管我们仍然需要在我们的函数中添加一个额外的 pure 以使其进入 Either 上下文。

这是相当高级的镜头东西，但归根结底，这一切都只是正常的遍历（大部分镜头都是）。

我有一个关于编写你自己的遍历的指南，这可能会帮助https://lens-by-example.chrispenner.ca/articles/traversals/writing-traversals

祝你好运！希望有帮助:)