Могу ли я создать что-то вроде линзы, когда мои геттер и сеттер возвращают «либо»?

Question

Вкратце

Мой геттер и сеттер оба могут потерпеть неудачу с сообщениями, описывающими как.Поэтому они возвращают 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, поэтому получатель должен иметь подпись, подобную getSubtree :: Path -> Tree a -> Either String (Tree a).Для установщика требуется аналогичная подпись (см. modSubtree ниже).

Если бы получатель и установщик возвращали значения типа Tree a, я бы использовал их для создания линзы, используя что-то вроде функции 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; Большинство обходов должны работать над ЛЮБОЙ аппликацией, но в нашем случае мы ЗНАЕМ, что хотим, чтобы наш результат был в любом из них; так что мы можем воспользоваться этим:

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; Обычно мы использовали бы здесь %~; но он ожидает конкретного Applicative, который не соответствует указанному нами Either String. %%~ успешно запускает наш пользовательский обход, хотя нам все еще нужно добавить дополнительный pure в нашу функцию, чтобы включить его в контекст Either.

Это довольно продвинутый объектив, но, в конце концов, это все обычные обходы (большинство объективов).

У меня есть руководство по написанию ваших собственных обходов, которое может помочь https://lens -by-example.chrispenner.ca / Articles / traversals / writing-traversals

Удачи! Надеюсь, это поможет:)