Haskell 如何将透镜（或任何其他光学元件）同时视为吸气剂和设置剂？

我正在尝试编写一个通用的记录更新程序，它允许人们轻松地更新

现有

记录中的字段，并使用形状类似的

传入

记录中的字段。以下是我到目前为止所拥有的：

applyUpdater fields existing incoming =
  let getters = DL.map (^.) fields
      setters = DL.map set fields
      updaters = DL.zipWith (,) getters setters
  in DL.foldl' (\updated (getter, setter) -> setter (getter incoming) updated) existing updaters

我希望以以下方式使用它：

applyUpdater 
  [email, notificationEnabled] -- the fields to be copied from incoming => existing (this obviously assumed that `name` and `email` lenses have already been setup
  User{name="saurabh", email="blah@blah.com", notificationEnabled=True}
  User{name="saurabh", email="foo@bar.com", notificationEnabled=False}

testUpdater :: User -> User -> User
testUpdater existingUser incomingUser = applyUpdater2 (email, notificationEnabled) existingUser incomingUser

这不起作用，可能是因为Haskell推断出一个非常奇怪的类型签名用于

applyUpdater

，这意味着它没有完成我期望它完成的任务：

applyUpdater :: [ASetter t1 t1 a t] -> t1 -> Getting t (ASetter t1 t1 a t) t -> t1

下面是一个代码示例和编译错误：

module TryUpdater where
import Control.Lens
import GHC.Generics
import Data.List as DL

data User = User {_name::String, _email::String, _notificationEnabled::Bool} deriving (Eq, Show, Generic)
makeLensesWith classUnderscoreNoPrefixFields ''User

-- applyUpdater :: [ASetter t1 t1 a t] -> t1 -> Getting t (ASetter t1 t1 a t) t -> t1
applyUpdater fields existing incoming =
  let getters = DL.map (^.) fields
      setters = DL.map set fields
      updaters = DL.zipWith (,) getters setters
  in DL.foldl' (\updated (getter, setter) -> setter (getter incoming) updated) existing updaters

testUpdater :: User -> User -> User
testUpdater existingUser incomingUser = applyUpdater [email, notificationEnabled] existingUser incomingUser

18  62 error           error:
 • Couldn't match type ‘Bool’ with ‘[Char]’
     arising from a functional dependency between:
       constraint ‘HasNotificationEnabled User String’
         arising from a use of ‘notificationEnabled’
       instance ‘HasNotificationEnabled User Bool’
         at /Users/saurabhnanda/projects/vl-haskell/.stack-work/intero/intero54587Sfx.hs:8:1-51
 • In the expression: notificationEnabled
   In the first argument of ‘applyUpdater’, namely
     ‘[email, notificationEnabled]’
   In the expression:
     applyUpdater [email, notificationEnabled] existingUser incomingUser (intero)
18  96 error           error:
 • Couldn't match type ‘User’
                  with ‘(String -> Const String String)
                        -> ASetter User User String String
                        -> Const String (ASetter User User String String)’
   Expected type: Getting
                    String (ASetter User User String String) String
     Actual type: User
 • In the third argument of ‘applyUpdater’, namely ‘incomingUser’
   In the expression:
     applyUpdater [email, notificationEnabled] existingUser incomingUser
   In an equation for ‘testUpdater’:
       testUpdater existingUser incomingUser
         = applyUpdater
             [email, notificationEnabled] existingUser incomingUser (intero)

编译错误：

module TryUpdater where
import Control.Lens
import GHC.Generics
import Data.List as DL

data User = User {_name::String, _email::String, _notificationEnabled::Bool} deriving (Eq, Show, Generic)
makeLensesWith classUnderscoreNoPrefixFields ''User

-- applyUpdater :: [ASetter t1 t1 a t] -> t1 -> Getting t (ASetter t1 t1 a t) t -> t1
applyUpdater fields existing incoming =
  let getters = DL.map (^.) fields
      setters = DL.map set fields
      updaters = DL.zipWith (,) getters setters
  in DL.foldl' (\updated (getter, setter) -> setter (getter incoming) updated) existing updaters

testUpdater :: User -> User -> User
testUpdater existingUser incomingUser = applyUpdater [email, notificationEnabled] existingUser incomingUser

18  62 error           error:
 • Couldn't match type ‘Bool’ with ‘[Char]’
     arising from a functional dependency between:
       constraint ‘HasNotificationEnabled User String’
         arising from a use of ‘notificationEnabled’
       instance ‘HasNotificationEnabled User Bool’
         at /Users/saurabhnanda/projects/vl-haskell/.stack-work/intero/intero54587Sfx.hs:8:1-51
 • In the expression: notificationEnabled
   In the first argument of ‘applyUpdater’, namely
     ‘[email, notificationEnabled]’
   In the expression:
     applyUpdater [email, notificationEnabled] existingUser incomingUser (intero)
18  96 error           error:
 • Couldn't match type ‘User’
                  with ‘(String -> Const String String)
                        -> ASetter User User String String
                        -> Const String (ASetter User User String String)’
   Expected type: Getting
                    String (ASetter User User String String) String
     Actual type: User
 • In the third argument of ‘applyUpdater’, namely ‘incomingUser’
   In the expression:
     applyUpdater [email, notificationEnabled] existingUser incomingUser
   In an equation for ‘testUpdater’:
       testUpdater existingUser incomingUser
         = applyUpdater
             [email, notificationEnabled] existingUser incomingUser (intero)

首先，请注意，

（^。）

将lens作为其正确的参数，因此您真正想要的实际上是

getters=DL.map（flip（^.）字段

，也称为

DL.map视图字段

但这里更有趣的问题是：光学要求更高的多态性等级，因此GHC只能猜测类型。因此，请始终从类型签名开始

天真地说，你可能会写作

applyUpdater :: [Lens' s a] -> s -> s -> s

嗯，这实际上不起作用，因为

Lens'

包含一个

∀量词，将其放入列表中。常见问题，因此镜头库有两种解决方法：


只是
函子
约束的一个特定实例，选择它是为了保留完整的通用性。然而，您需要使用不同的组合符来应用它

applyUpdater :: [ALens' s a] -> s -> s -> s
applyUpdater fields existing incoming =
 let getters = DL.map (flip (^#)) fields
     setters = DL.map storing fields
     updaters = DL.zipWith (,) getters setters
 in DL.foldl' (\upd (γ, σ) -> σ (γ incoming) upd) existing updaters

因为
ALens
严格地说是
Lens
的一个实例，所以您可以完全按照您想要的方式使用它

保留原始多态性，但将其包装为新类型，以便将镜头存储在列表中。然后，可以像往常一样使用包装好的镜头，但是您需要显式地包装它们才能传递到您的函数中；对于您的应用程序来说，这可能不值得这么麻烦。当您希望以不太直接的方式重新使用存储的镜头时，这种方法更有用。（这也可以通过
ALens
实现，但它需要
cloneLens
，我认为这对性能不利。）


applyUpdater
现在将按照我在
ALens'
中解释的方式工作，但是它只能用于相同类型的所有聚焦场的透镜列表。将镜头聚焦在列表中不同类型的字段上显然是一种类型错误。要做到这一点，您必须将镜头包装成某种新类型以隐藏类型参数–无法绕过它，根本不可能将
email
和
notificationEnabled
的类型统一到一个列表中

<> P>但是在经历这个麻烦之前，我会强烈地考虑不要在列表中存储任何镜片：基本上是什么只是组成更新功能，所有的功能都访问共享引用。好吧，直接这样做——“所有访问共享引用”都是monad函数提供给您的，因此编写起来很简单

applyUpdater :: [s -> r -> s] -> s -> r -> s
applyUpdater = foldr (>=>) pure

要将镜头转换为单个更新程序函数，请编写

mkUpd :: ALens' s a -> s -> s -> s
mkUpd l exi inc = storing l (inc^#l) exi

像

applyUpdater 
  [mkUpd email, mkUpd notificationEnabled]
  User{name="saurabh", email="blah@blah.com", notificationEnabled=True}
  User{name="saurabh", email="foo@bar.com", notificationEnabled=False}

根据@leftaroundabout的回答，还有一种基于元组的方法：

applyUpdater2 (f1, f2) existing incoming = (storing f2 (incoming ^# f2)) $ (storing f1 (incoming ^# f1) existing)
applyUpdater3 (f1, f2, f3) existing incoming = (storing f3 (incoming ^# f3)) $ (applyUpdater2 (f1, f2) existing incoming)
applyUpdater4 (f1, f2, f3, f4) existing incoming = (storing f4 (incoming ^# f4)) $ (applyUpdater3 (f1, f2, f3) existing incoming)
-- and so on

可按以下方式使用：

applyUpdater 
  [email, notificationEnabled] -- the fields to be copied from incoming => existing (this obviously assumed that `name` and `email` lenses have already been setup
  User{name="saurabh", email="blah@blah.com", notificationEnabled=True}
  User{name="saurabh", email="foo@bar.com", notificationEnabled=False}

testUpdater :: User -> User -> User
testUpdater existingUser incomingUser = applyUpdater2 (email, notificationEnabled) existingUser incomingUser

设置
applyUpdaterN
till，比如说32元组，应该很容易。之后，一切都归结为个人偏好和实际用例。您可能不希望在每个调用站点都使用
mkUpd
包装更新程序。另一方面，如果您想动态生成更新程序列表，那么使用列表比使用元组更容易。
我尝试了您建议的使用
ALens'
的方法，但现在我遇到了一个不同的错误：
无法将类型“s”与“ALens”（ALens's a）匹配t0 a b0“s”是一个刚性类型变量，由以下类型签名绑定：applyUpdater:：forall s a。[ALens's a]->s->s at/Users/saurabhnanda/projects/vl haskell/.stack work/intero/intero54587Sfx.hs:10:17预期类型：[（s->a，a->s->s）]实际类型：[（ALens a）t0 a b0->a，a->s->s）]
代码还有另一个问题，即您已经部分应用了
^.
，分别是
^#
，方向不对。是否使用
DL.map（flip（^#））字段
？
applyUpdater
使用
flip
编译，但实际使用它仍会导致类型错误。例如：
testUpdater existingUser incomingUser=applyUpdater[email，notificationEnabled]existingUser incomingUser
结果中的
无法将类型“Bool”与“[Char]匹配'源于以下之间的函数依赖关系：约束'HasNotificationEnabled User String'源于'notificationEnabled'实例'HasNotificationEnabled User Bool'的使用。
Uh，是否要将镜头放置到单个列表中的不同类型字段？这不起作用并不奇怪，对吧？可以用元组来代替吗？类似于
applyUpdater2
applyUpdater3
，
applyUpdater4
，等等？