镜头和类型系列

Posted 2023-02-19

【中文标题】镜头和类型系列

【英文标题】：Lenses and TypeFamilies

【发布时间】：2018-06-05 09:46:31

【问题描述】：

我遇到了Control.Lens与一起使用的问题 使用-XTypeFamilies GHC pragma 时的数据类型。

-# LANGUAGE TemplateHaskell #-
-# LANGUAGE TypeFamilies    #-

import Control.Lens (makeLenses)

class SomeClass t where
  data SomeData t :: * -> *

data MyData = MyData Int

instance SomeClass MyData where
  data SomeData MyData a = SomeData _a :: a, _b :: a

makeLenses ''SomeData

错误消息是：reifyDatatype: Use a value constructor to reify a data family instance。

有没有办法克服它，也许使用Control.Lens 的一些功能？

【问题讨论】：

我猜lens 包无法为相关数据系列实现镜头。我发现microlens 库的类似问题报告（这个库使用相同的makeLenses 函数）：github.com/aelve/microlens/issues/93 所以这里可能没有运气。我建议您在lens github 存储库中创建问题。或者，您可以创建自己的 -XTemplateHaskell 宏来专门为您的情况生成镜头...

【参考方案1】：

这个答案是对 errfrom 的原始答案的改编，其中包含更多细节。下面的函数还可以创建镜头，而不仅仅是设置器。

tfMakeLenses 生成 Lens' s a 类型的镜头，或者根据定义，(a -> f a) -> s -> f s 用于关联数据类型。

-# TemplateHaskell #-
import Control.Lens.TH
import Language.Haskell.TH.Syntax

tfMakeLenses typeFamilyName = do
  fieldNames <- tfFieldNames typeFamilyName
  let associatedFunNames = associateFunNames fieldNames
  return $ map createLens associatedFunNames

  where -- Creates a function of the form:
        -- funName lensFun record = fmap (\newValue -> record fieldName=newValue) (lensFun (fieldName record))
        createLens :: (Name, Name) -> Dec
        createLens (funName, fieldName) =
          let lensFun   = mkName "lensFunction"
              recordVar = mkName "record"
              valVar    = mkName "newValue"
              setterFunction = LamE [VarP valVar] $ RecUpdE (VarE recordVar) [(fieldName, VarE valVar)]
              getValue       = AppE (VarE fieldName) (VarE recordVar)
              body           = NormalB (AppE (AppE (VarE 'fmap) setterFunction) (AppE (VarE lensFun) getValue))
          in FunD funName [(Clause [VarP lensFun, VarP recordVar] body [])]

        -- Maps [Module._field1, Module._field2] to [(field1, _field1), (field2, _field2)]
        associateFunNames :: [Name] -> [(Name, Name)]
        associateFunNames = map funNames
                            where funNames fieldName = ((mkName . tail . nameBase) fieldName, (mkName . nameBase) fieldName)

        -- Retrieves fields of last instance declaration of type family "t"
        tfFieldNames t = do
          FamilyI _ ((DataInstD _ _ _ _ ((RecC _ fields):_) _):_) <- reify t
          let fieldNames = flip map fields $ \(name, _, _) -> name
          return fieldNames

用法：将类型姓氏传递给tfMakeLenses。将为调用之前的最后一个类型族实例创建镜头。

class SomeClass t where
  data SomeData t :: * -> *

data MyData = MyData Int

instance SomeClass MyData where
  data SomeData MyData a = SomeData _a :: a, _b :: a

tfMakeLenses ''SomeData

【参考方案2】：

tfMakeLenses 为关联的数据类型生成 t a -> a -> t a 类型的设置器。 这个功能有一些地方可以改进，但它确实有效！

tfMakeLenses :: Name -> DecsQ
tfMakeLenses t = do
  fieldNames <- tfFieldNames t
  let associatedFunNames = associateFunNames fieldNames
  return (map createLens associatedFunNames)
  where createLens :: (Name, Name) -> Dec
        createLens (funName, fieldName) =
          let dtVar  = mkName "dt"
              valVar = mkName "newValue"
              body   = NormalB (LamE [VarP valVar] (RecUpdE (VarE dtVar) [(fieldName, VarE valVar)]))
          in FunD funName [(Clause [VarP dtVar] body [])]

        associateFunNames :: [Name] -> [(Name, Name)]
        associateFunNames [] = []
        associateFunNames (fieldName:xs) = ((mkName . tail . nameBase) fieldName, (mkName . nameBase) fieldName)
                                         : associateFunNames xs

        tfFieldNames t = do
          FamilyI _ ((DataInstD _ _ _ _ ((RecC _ fields):_) _):_) <- reify t
          let fieldNames = flip map fields $ \(name, _, _) -> name
          return fieldNames

【讨论】：

二传手还是镜头？你的说法有点混乱。此外，您的代码需要更多解释才能成为正确答案！

@dfeuer 它在这里并不重要，可以很容易地适应生成镜头而不是纯粹的二传手。但是，是的，你是绝对正确的 - 这个答案可以改进。过一段时间我会这样做=）

【参考方案3】：

最明智的做法是自己定义这些镜头......这并不是很难：

a, b :: Lens' (SomeData MyData a) a
a = lens _a (\s a' -> s_a=a')
b = lens _b (\s b' -> s_b=b')

甚至

a, b :: Functor f => (a -> f a) -> SomeData MyData a -> f (SomeData MyData a)
a f (SomeData a₀ b₀) = (`SomeData`b₀) <$> f a₀
b f (SomeData a₀ b₀) =   SomeData a₀  <$> f b₀

...完全不使用镜头库中的任何内容，但与所有镜头组合器完全兼容。

【讨论】：

不幸的是，这不是我的情况的解决方案。假设数据类型可能包含更多字段。

如果字段如此之多，以至于您无法用一行来为每个字段定义一个镜头，那么我严重质疑将其定义为一个整体数据结构是一个聪明的主意。如果你只是觉得重复很难看 - 好的，但这可以通过一个简单的 CPP 宏来解决。

@errfrom 无论您的数据类型有多少字段，它都有效。除非您正在生成这些数据类型并且需要自动派生镜头，否则这只是一点点乏味的问题。

我不认为这只是乏味的问题；这是可能导致许多错误的代码重复，并且具有样板文件的所有问题。