如何将镜片(或任何其他镜片)同时作为吸气剂和固定剂处理?

时间:2017-08-10 15:40:15

标签: haskell lens

我试图编写一个通用记录更新程序,它允许用户轻松更新existing记录中的字段,其中的字段位于类似形状的incoming记录中。这就是我现在所拥有的:

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}

这不起作用,可能是因为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)

1 个答案:

答案 0 :(得分:0)

根据@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

可以通过以下方式使用:

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

设置applyUpdaterN直到32个元组,应该很容易。在那之后,这一切都归结为个人偏好和实际用例。 可能不希望在每个呼叫站点都使用mkUpd包装更新程序。另一方面,如果要动态生成updaters列表,那么使用列表比使用元组更容易。