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

Writing a function that is polymorphic over lenses for a given datatype?

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

{-# 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 可能会奏效:

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 函数实际可用的方式将 class 添加到约束中,即使在我尝试使用它之前它的类型检查很好。 (尽管如果我使用 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 newtypes,但这并没有解决函数依赖性问题。

我想不通的是,如果我像这样修改 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 函数,但它几乎没用...

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

有什么方法可以用镜头完成我在这里尝试做的事情,或者如果没有像命令类型这样的东西是不可能的?如果没有,是否有比我看到的更好的解决方法?

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

但似乎这些方面的东西 应该 是可能的,因为当 stringToLens 的输出被传递给 updateFoo 时,它将有一个确定的(和正确的)类型.所以我很困惑。

实现 stringToLens 需要依赖类型之类的东西,因为结果 Lenstype 取决于参数的 value:字段名。 Haskell 没有完整的依赖类型,尽管它们可能 emulated 或多或少有些困难。

updateFoo 中,您将字段名称 (lensStr) 和字段值的“序列化”形式 (valStr) 作为参数,并且 return 某些数据类型的更新函数。我们可以在没有得到 dependent-ish 的情况下得到它吗?

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

如何为给定类型构建这样的 map-of-parsers-returning-updaters?您可以手动构建它,也可以在一些 generics wizardry.

的帮助下派生它

这是一个基于 red-black-record library (although it would be better to base it on the more established 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