为给定的数据类型编写一个在镜头上多态的函数？

Question

不确定我是否在标题中正确表达了问题，但我正在尝试做这样的事情：

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

module Lib where

import Control.Lens 


data Foo = Foo {_bar1 :: Int
               ,_bar2 :: String
               ,_bar3 :: [Rational]} deriving (Show, Eq)
makeFieldsNoPrefix ''Foo

aFoo :: Foo
aFoo = Foo 33 "Hm?" [1/6,1/7,1/8]


stringToLens :: (HasBar1 s a, Functor f, HasBar2 s a, HasBar3 s a) => String -> Maybe ((a -> f a) -> s -> f s)
stringToLens str = case str of
    "bar1" -> Just  bar1
    "bar2" -> Just  bar2
    "bar3" -> Just  bar3
    _      -> Nothing 

updateFoo :: (HasBar1 a1 a2, HasBar2 a1 a2, HasBar3 a1 a2, Read a2) => String -> String -> a1 -> Maybe a1
updateFoo lensStr valStr myFoo = case stringToLens lensStr of
    Just aLens ->  Just $ set aLens (read valStr) myFoo
    Nothing    -> Nothing 

newFoo :: Maybe Foo
newFoo = updateFoo "bar1" 22 aFoo  
{-- 
Couldn't match type ‘[Char]’ with ‘Int’
    arising from a functional dependency between:
      constraint ‘HasBar2 Foo Int’ arising from a use of ‘updateFoo’
      instance ‘HasBar2 Foo String’
        at /home/gnumonic/Haskell/Test/test/src/Lib.hs:14:1-24
• In the expression: updateFoo "bar1" 22 aFoo
  In an equation for ‘newFoo’: newFoo = updateFoo "bar1" 22 aFoo 
  --}

（忽略此处对 read 的使用，我在我正在处理的实际模块中以“正确的方式”进行操作。）

这显然行不通。我认为按照这样的方式制作一个类型类可能会起作用：

class OfFoo s a where
  ofFoo :: s -> a

instance OfFoo Foo Int where
  ofFoo foo = foo ^. bar1 

instance OfFoo Foo String where
  ofFoo foo = foo ^. bar2

instance OfFoo Foo [Rational] where
  ofFoo foo = foo ^. bar3 

但是似乎没有办法将该类添加到约束中，使得 stringToLens 函数实际上可用，即使在我尝试使用它之前它的类型检查正常。 （尽管如果我使用 makeLenses 而不是 makeFields，它甚至不会进行类型检查，而且我不确定为什么。）

例如（为简单起见，可能删除了）：

stringToLens :: (HasBar1 s a, Functor f, HasBar2 s a, HasBar3 s a, OfFoo s a) => String -> (a -> f a) -> s -> f s
stringToLens str = case str of
    "bar1" -> bar1
    "bar2" ->  bar2
    "bar3" ->  bar3  

这种类型检查但几乎没用，因为任何应用函数的尝试都会引发函数依赖错误。

我也尝试使用 Control.Lens.Reify 中的 Reified 新类型，但这并没有解决函数依赖问题。

我想不通的是，如果我像这样修改updateFoo：

updateFoo2 :: Read a => ASetter Foo Foo a a -> String -> Foo -> Foo
updateFoo2 aLens val myFoo = set aLens (read val) myFoo 

然后这个工作：

testFunc :: Foo
testFunc = updateFoo2 bar1 "22" aFoo

但这会在使用 myLens1 时引发函数依赖错误（尽管定义类型检查）：

testFunc' :: Foo
testFunc' = updateFoo2 (stringToLens "bar1") 22 aFoo -- Error on (stringToLens "bar1")

myLens1 :: (HasBar1 s a, Functor f, HasBar2 s a, HasBar3 s a, OfFoo s a) => (a -> f a) -> s -> f s
myLens1 = stringToLens "bar1" -- typechecks

testFunc2 :: Foo
testFunc2 = updateFoo2 myLens1 "22" aFoo   -- Error on myLens1

所以我可以定义一个 stringToLens 函数，但它几乎没用......

不幸的是，我写了一堆代码，假设像这样的 something 可以工作。我正在编写一个数据包生成器，如果我能让它工作，那么我有一个非常方便的方法来快速添加对新协议的支持。 （我的其余代码广泛使用镜头用于各种目的。）我可以想到一些解决方法，但它们都非常冗长并且需要大量模板 Haskell（为每个新协议生成每个函数的副本数据类型）或大量样板文件（即在updateFoo 函数中创建虚拟类型以指示read 的正确类型）。

有没有什么办法可以用镜头做我在这里尝试做的事情，或者如果没有类似暗示类型的东西就不可能？如果没有，是否有更好的解决方法？

在这一点上，我最好的猜测是编译器没有足够的信息来推断值字符串的类型，而没有完全评估的镜头。

但似乎沿着这些思路应该是可能的，因为当 stringToLens 的输出被传递给 updateFoo 时，它将有一个明确的（和正确的）类型。所以我被难住了。

Answer 1

实现stringToLens 需要依赖类型，因为生成的Lens 的类型 取决于参数的值：字段名称。 Haskell 没有完全依赖的类型，尽管它们可以是 emulated 或多或少的困难。

在updateFoo 中，您将字段名称 (lensStr) 和字段值的“序列化”形式 (valStr) 作为参数，并返回某个数据类型的更新函数。我们可以在不依赖的情况下拥有它吗？

想象一下，对于某个类型 Foo，您有类似 Map FieldName (String -> Maybe (Foo -> Foo)) 的东西。对于每个字段名称，您将拥有一个解析字段值的函数，如果成功，则返回 Foo 的更新函数。不需要依赖类型，因为每个字段值的解析将隐藏在具有统一签名的函数后面。

如何为给定类型构建这样的解析器映射返回更新器？您可以手动构建它，也可以借助一些 generics wizardry 导出它。

---

这是一个基于red-black-record 库的可能实现（尽管最好基于更成熟的generics-sop）。一些初步导入：

{-# LANGUAGE DeriveGeneric, FlexibleContexts, FlexibleInstances, #-}
{-# LANGUAGE TypeApplications, TypeFamilies, TypeOperators, ScopedTypeVariables #-}
import qualified Data.Map.Strict as Map
import Data.Map.Strict
import Data.Monoid (Endo (..))
import Data.Proxy
import Data.RBR
  ( (:.:) (Comp),
    And,
    Case (..),
    FromRecord (fromRecord),
    I (..),
    IsRecordType,
    K (..),
    KeyValueConstraints,
    KeysValuesAll,
    Maplike,
    Record,
    ToRecord (toRecord),
    collapse'_Record,
    cpure'_Record,
    injections_Record,
    liftA2_Record,
    unI,
  )
import GHC.Generics (Generic)
import GHC.TypeLits

实现本身：

type FieldName = String

type TextInput = String

makeUpdaters ::
  forall r c.
  ( IsRecordType r c, -- Is r convertible to the rep used by red-black-record?
    Maplike c, -- Required for certain applicative-like operations over the rep.
    KeysValuesAll (KeyValueConstraints KnownSymbol Read) c -- Are all fields readable?
  ) =>
  Proxy r ->
  Map FieldName (TextInput -> Maybe (r -> r))
makeUpdaters _ =
  let parserForField :: forall v. Read v 
                     => FieldName -> ((,) FieldName :.: (->) TextInput :.: Maybe) v
      parserForField fieldName = Comp (fieldName, Comp read)
      parserRecord = cpure'_Record (Proxy @Read) parserForField
      injectParseResult ::
        forall c a.
        Case I (Endo (Record I c)) a -> -- injection into the record
        ((,) FieldName :.: (->) TextInput :.: Maybe) a -> -- parsing function
        (FieldName, Case I (Maybe (Endo (Record I c))) TextInput) 
      injectParseResult (Case makeUpdater) (Comp (fieldName, Comp readFunc)) =
        ( fieldName,
          ( Case $ \textInput ->
              let parsedFieldValue = readFunc . unI $ textInput
               in case parsedFieldValue of
                    Just x -> Just $ makeUpdater . pure $ x
                    Nothing -> Nothing ) )
      collapsed :: [(FieldName, Case I (Maybe (Endo (Record I c))) TextInput)]
      collapsed = collapse'_Record $
          liftA2_Record
            (\injection parser -> K [injectParseResult injection parser])
            injections_Record
            parserRecord
      toFunction :: Case I (Maybe (Endo (Record I c))) TextInput 
                 -> TextInput -> Maybe (r -> r)
      toFunction (Case f) textInput = case f $ I textInput of
        Just (Endo endo) -> Just $ fromRecord . endo . toRecord
        Nothing -> Nothing
   in toFunction <$> Map.fromList collapsed

测试它的类型：

data Person = Person {name :: String, age :: Int} deriving (Generic, Show)
-- let updaters = makeUpdaters (Proxy @Person)
--
instance ToRecord Person

instance FromRecord Person