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

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

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