haskell - 对于可能作为二传手失败的镜头，适当的抽象是什么？

Question

我想定义像镜头这样的东西，但在尝试设置时可能会失败。请参阅以下示例中的 fooLens。

{-# LANGUAGE RankNTypes #-}

import Data.Char (toUpper)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Getting r s t a = (a -> Const r a) -> s -> Const r t

view :: Getting a s t a -> s -> a
view l = getConst . l Const

over :: Lens s t a b -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)

data Foo a = Foo a deriving (Show)

fooLens :: Lens (Foo a) (Either String (Foo a)) a a
fooLens f (Foo a) = Right . Foo <$> f a

main = do
    let foo = Foo "test"
    print foo
    print $ view fooLens foo
    print $ over fooLens (map toUpper) foo

这就是你所期望的结果

Foo "test"
"test"
Right (Foo "TEST")

我在此处概括了Getting 的定义以使其有效。首先要明确的是 fooLens 不是镜头:它不满足镜头定律。相反，它是由透镜和棱镜之类的东西组成的。

这似乎可行，但事实上我检查过的任何镜头库都不支持它，这表明可能有更好的方法来解决这个问题。有没有办法重构 fooLens 以便它:

1. 充当 setter/getter ，即它始终可以检索值。
2. 可以作为有失败可能性的 setter，例如它返回一个 Either。

Answer 1

您的特定配方在镜头生态系统中效果不佳。镜头所做的最重要的事情是提供不同类型的光学组合。为了进行演示，让我们从您的代码的一个稍微修饰的版本开始:

{-# LANGUAGE RankNTypes #-}

import Data.Char (toUpper)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Getting r s t a = (a -> Const r a) -> s -> Const r t

view :: Getting a s t a -> s -> a
view l = getConst . l Const

over :: Lens s t a b -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)

data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens :: Lens (Foo [a]) (Either String (Foo [a])) [a] [a]
fooLens f (Foo a) = update <$> f a
  where
    update x | null x = Left "Cannot be empty"
             | otherwise = Right (Foo x)

main = do
    let foo = Foo "test"
    print foo
    print $ view fooLens foo
    print $ over fooLens (map toUpper) foo
    print $ over fooLens (const "") foo

输出是:

Foo "test"
"test"
Right (Foo "TEST")
Left "Cannot be empty"

我修改了fooLens有点充分利用其类型，在更新时验证数据。这有助于说明此公式的目标。

然后我决定测试它的组合效果，并添加了以下内容:

data Bar = Bar (Foo String)
    deriving (Show, Eq, Ord)

barLens :: Lens Bar Bar (Foo String) (Foo String)
barLens f (Bar x) = Bar <$> f x

然后将以下内容添加到 main :

    print $ view (barLens . fooLens) (Bar foo)

它只是不组成:

error:
    • Couldn't match type ‘Either String (Foo [Char])’
                     with ‘Foo String’
      Expected type: ([Char] -> Const [Char] [Char])
                     -> Foo String -> Const [Char] (Foo String)
        Actual type: ([Char] -> Const [Char] [Char])
                     -> Foo [Char] -> Const [Char] (Either String (Foo [Char]))
    • In the second argument of ‘(.)’, namely ‘fooLens’
      In the first argument of ‘view’, namely ‘(barLens . fooLens)’
      In the second argument of ‘($)’, namely
        ‘view (barLens . fooLens) (Bar foo)’
   |
37 |     print $ view (barLens . fooLens) (Bar foo)
   |                             ^^^^^^^

仅此一项就足以防止在镜头中使用该配方。它不符合图书馆的目标。

让我们尝试一些不同的东西。这不完全是您要查找的内容，但它是一种观察结果。

import Control.Lens

data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens :: Lens (Foo [a]) (Foo [a]) [a] [a]
fooLens f (Foo a) = update <$> f a
  where
    update x | null x = Foo a
             | otherwise = Foo x

main :: IO ()
main = do
    let foos = map Foo $ words "go fly a kite"
    print foos
    print $ toListOf (traverse . fooLens) foos
    print $ over (traverse . fooLens) tail foos
    print =<< (traverse . fooLens) (\x -> tail x <$ print x) foos

输出:

[Foo "go",Foo "fly",Foo "a",Foo "kite"]
["go","fly","a","kite"]
[Foo "o",Foo "ly",Foo "a",Foo "ite"]
"go"
"fly"
"a"
"kite"
[Foo "o",Foo "ly",Foo "a",Foo "ite"]

显然，这不是真正的镜头，可能应该有不同的名称，因为它不遵守 set-view 法则。可以用相同的类型来写有点尴尬，但是像 filtered 这样的东西是有先例的。 .

但还有一个更复杂的问题，正如上次测试所证明的那样——过滤更新结果仍然需要运行更新的效果，即使更新被拒绝。这不是用 filtered 跳过元素的方式例如，在 Traversal 中作品。这似乎无法通过 van Laarhoven 代表来避免。但也许这还不错。这在设置或查看时不是问题 - 只有在执行不太常见的操作时才会出现。

无论如何，它不会报告设置失败，因此它并不是您要查找的内容。但经过充分的调整，它可以成为一个起点。

{-# LANGUAGE
        MultiParamTypeClasses,
        FlexibleInstances,
        TypeFamilies,
        UndecidableInstances,
        FlexibleContexts #-}

import Data.Functor.Identity
import Control.Applicative
import Control.Monad

import Control.Lens



class Functor f => Reportable f e where
    report :: a -> f (Either e a) -> f a

instance Reportable (Const r) e where
    report _ (Const x) = Const x

instance Reportable Identity e where
    report a (Identity i) = Identity $ either (const a) id i

instance (e ~ a) => Reportable (Either a) e where
    report _ = join

overWithReport
    :: ((a -> Either e b) -> s -> Either e t)
    -> (a -> b)
    -> s
    -> Either e t
overWithReport l f s = l (pure . f) s



data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens
    :: (Reportable f String)
    => ([a] -> f [a])
    -> Foo [a]
    -> f (Foo [a])
fooLens f (Foo a) = report (Foo a) $ update <$> f a
  where
    update x | null x = Left "Cannot be empty"
             | otherwise = Right $ Foo x



main :: IO ()
main = do
    let foos = [Foo [1], Foo [2, 3]]
    print foos

    putStrLn "\n  Use as a normal lens:"
    print $ toListOf (traverse . fooLens . traverse) foos
    print $ over (traverse . fooLens . traverse) (+ 10) foos
    print $ over (traverse . fooLens) tail foos

    putStrLn "\n  Special use:"
    print $ overWithReport (traverse . fooLens . traverse) (+ 10) foos
    print $ overWithReport (traverse . fooLens) (0 :) foos
    print $ overWithReport (traverse . fooLens) tail foos

这是运行它的输出:

[Foo [1],Foo [2,3]]

  Use as a normal lens:
[1,2,3]
[Foo [11],Foo [12,13]]
[Foo [1],Foo [3]]

  Special use:
Right [Foo [11],Foo [12,13]]
Right [Foo [0,1],Foo [0,2,3]]
Left "Cannot be empty"

此配方与普通镜片 Material 相结合。它有效，但需要对 over 进行修改获取错误报告。它保持与许多镜头功能的兼容性，在一种情况下以一些非法行为为代价。它并不完美，但它可能在保持与镜头库其余部分的兼容性的限制范围内尽可能接近。

至于为什么库中没有这些内容，可能是因为它需要对 f 进行自定义约束。类型别名，这对于使用像 (%%~) 这样的组合器来说真的很麻烦.我为 Identity 提供的实例和 Const照顾镜头本身的大部分用途，但有更多的人可能会选择用它来做。

镜头库的开放式设计允许进行大量的外部定制。这是一种可能适用于很多情况的可能方法。但它的工作范围比镜头允许的范围要小得多，我认为这就是为什么目前没有这样的东西。