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

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函数实际上是可用的，即使在我尝试使用它之前它的类型检查很好

例如(为了简单起见，可能已删除(：

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函数，但它几乎没有用。。。

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

有没有什么方法可以做到我在这里试图用镜头做的事情，或者如果没有像不确定类型的东西，这是不可能的？如果没有，有没有比我看到的那个更好的解决方法？

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

但是，类似于这样的事情似乎是可能的，因为当stringToLens的输出被传递给updateFoo时，它将有一个确定的(正确的(类型。所以我被难住了。

Answer 1

实现stringToLens需要类似于依赖类型的东西，因为生成的Lens的类型取决于参数的值：字段名。Haskell没有完全依赖的类型，尽管它们可以或多或少地进行模拟。

在updateFoo中，您将字段名称(lensStr(和"；序列化的"；字段值的形式(valStr(，并返回某个数据类型的更新函数。我们能在不依赖的情况下做到这一点吗？

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

如何构建这样的解析器映射，返回给定类型的更新程序？您可以手动构建它，也可以在一些泛型魔法的帮助下派生它。

---

这里有一个基于红黑记录库的可能实现(尽管最好基于更成熟的泛型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