对于可能无法作为设置器的镜头，适当的抽象是啥？

Posted 2023-02-19

【中文标题】对于可能无法作为设置器的镜头，适当的抽象是啥？

【英文标题】：What is the appropriate abstraction for a lens which can fail as a setter?对于可能无法作为设置器的镜头，适当的抽象是什么？

【发布时间】：2021-09-07 23:43:51

【问题描述】：

我想定义一个镜头之类的东西，但在尝试设置时可能会失败。请参阅以下示例中的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 以便它：

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

【问题讨论】：

这个问题的标题暗示了一个与正文提出的不同的问题。 Prism 在检索值时可能会失败，但在设置它时不会。您是否正在寻找相反的东西，一种总是可以检索值但有时可能无法设置它的光学元件？

@Carl：是的，这就是我想要的。但是，我选择在问题标题中更简洁，而不是“未知的类似光学的抽象”。如果您觉得这太误导了，我可以更改它，但我不确定该怎么做。

嗯，您提出的编号问题最终都是关于实现目标的一种特定方式，而不是实现目标的最佳方式。您在制作这个问题时有点 XY 问题。如果人们只关注你提出的编号问题，他们就不太可能回答你真正的问题。

啊，是的，好点子。我已经改写了我最后的问题。

【参考方案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"]

显然这不是一个真正的镜头，可能应该有一个不同的名称，因为它不遵守集合视图定律。可以用相同的类型写有点尴尬，但是filtered之类的东西是有先例的。

但还有一个更复杂的问题，正如上次测试所证明的那样 - 过滤更新的结果仍然需要运行更新的效果，即使更新被拒绝。这不是在Traversal 中跳过一个元素的方式，例如filtered。 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"

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

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

镜头库的开放式设计允许进行大量的外部定制。这是一种可能适用于很多情况的方法。但它的效果远远低于镜头所允许的全部范围，我认为这就是目前没有这样的东西的原因。

【参考方案2】：

我认为这是因为 Profunctor 光学有一个未说明的类型级定律。 s t a b 光学类型需要满足类型级定律：a ~ b 隐含s ~ t。

因此，Getting 没有被泛化，因为它的类型有 a ~ b，这意味着 s ~ t。同样，fooLens 不是一个已知的光学元件，因为它违反了这条法律，所以它有点不适合。

正如我所说，我从未见过明确表示过这种类型级别的法律，但我认为它是隐含的。

【讨论】：

在comonad.com/reader/2012/mirrored-lenses 中稍微间接地说明了这一点，镜头文档仍然引用了它。请参阅“为什么是镜头系列？”部分，并注意它给出的伪 Haskell 公式要求您的类型级定律为真。

我认为在侧面改变幻影是完全明智的。

@Carl：该部分似乎通过引用镜头定律来证明它的合理性。但是，目前尚不清楚为什么其他光学器件必须如此。

嗯，我想很清楚为什么它需要为等式、isos、透镜、遍历、棱镜和设置器保持不变，这样就真的只剩下吸气剂和折叠了。我想我不清楚Getting r s t a 真正能买到什么额外的通用性。我的意思是，为什么要停在那里？代表从s 获得a 而将t 中的b 设置为c 以获得u 的光学元件在哪里？如果s、t、a 和b 类型之间没有潜在的语义关系，那为什么还要有光学呢？只需使用单独的 getter 和 setter，其余的就不用管了。

我认为在这种情况下，s、t、a 和 b 之间存在语义关系，并且我们确实有类似于此处适用的棱镜定律. set l (view l b) ≡ Right b set l s ≡ Right a 暗示 view l a ≡ s 我不确定 matching 的类似物是什么，但可能可以定义一些东西。