对于可能作为 setter 失败的镜头，适当的抽象是什么？
What is the appropriate abstraction for a lens which can fail as a setter?
我想定义一个镜头之类的东西，但在尝试设置时可能会失败。请参阅以下示例中的 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，但有可能会失败，例如 returns 一个 Either。
我认为这是因为有一个未说明的 profunctor 光学类型级定律。 s t a b 光学类型需要满足类型级别法则：a ~ b 意味着 s ~ t.
因此，Getting 没有被泛化，因为它的类型有 a ~ b，这意味着 s ~ t。同样，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, 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"
此配方与普通镜片材料相结合。它可以工作，但需要对 over 进行修改才能获得错误报告。它保持与许多镜头功能的兼容性，在一种情况下以一些非法行为为代价。它并不完美，但在保持与镜头库其余部分的兼容性的限制下，它可能尽可能接近。
至于为什么这些内容不在库中，可能是因为它需要对 f 类型别名进行自定义约束，这对于使用像 [=26 这样的组合器来说是一个真正的麻烦=].我为 Identity 和 Const 提供的实例处理了镜头本身的大部分用途，但还有更多人可能会选择使用它。
镜头库的开放式设计允许进行大量的外部定制。这是一种可能适用于很多情况的可能方法。但它的工作范围比镜头允许的范围要小得多，我认为这就是为什么目前没有这样的东西。
我想定义一个镜头之类的东西，但在尝试设置时可能会失败。请参阅以下示例中的 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，但有可能会失败，例如 returns 一个 Either。
我认为这是因为有一个未说明的 profunctor 光学类型级定律。 s t a b 光学类型需要满足类型级别法则：a ~ b 意味着 s ~ t.
因此，Getting 没有被泛化，因为它的类型有 a ~ b，这意味着 s ~ t。同样，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, 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"
此配方与普通镜片材料相结合。它可以工作，但需要对 over 进行修改才能获得错误报告。它保持与许多镜头功能的兼容性，在一种情况下以一些非法行为为代价。它并不完美，但在保持与镜头库其余部分的兼容性的限制下，它可能尽可能接近。
至于为什么这些内容不在库中，可能是因为它需要对 f 类型别名进行自定义约束，这对于使用像 [=26 这样的组合器来说是一个真正的麻烦=].我为 Identity 和 Const 提供的实例处理了镜头本身的大部分用途，但还有更多人可能会选择使用它。
镜头库的开放式设计允许进行大量的外部定制。这是一种可能适用于很多情况的可能方法。但它的工作范围比镜头允许的范围要小得多，我认为这就是为什么目前没有这样的东西。