如何简化将多态字段名称上的字段调用到一个类型类中

How to simplify calling a field on a polymorphic field name into one typeclass

I asked how a record field can be made polymorphic when using DuplicateRecordFields. I got an excellent answer for this from @user2407038。他回答了我最初规范的问题,为每个字段提供一种类型 class,但他提到它可以全部简化为一种类型 class。

(Note: this too can be generalized to a single class with an additional parameter corresponding to the field name; this is probably outside the scope of this question).

我不确定如何进行这种概括。有人知道如何实现吗?

定义这样的 class 很容易

-- s has a field named field of type a and setting it to b turns the s into a t
class HasLens field s t a b | field s -> a, field t -> b, field s b -> t, field t a -> s where
  -- Fundeps are pretty common sense, and also appear in the library linked in the comments
  lensOf :: Functor f => (a -> f b) -> s -> f t
  -- Not sure why the library linked above includes f in the class head...

你会注意到 fieldlensOf 的类型中没有出现,所以这个 class 将无法使用,因为推理者永远无法弄清楚它应该是什么是。您有这些选择:

旧:

class HasLens name s t a b | ... where
  lensOf :: Functor f => Proxy name -> (a -> f b) -> s -> f t
  -- Or Proxy#, which has no runtime overhead, or forall proxy. Functor f => proxy name -> ...

Proxy 参数是一个哑元;除了告诉编译器关于 name 之外,它从不用于任何其他用途。不过,用法丑陋得令人难以忍受:

lensOf (Proxy :: Proxy "field")
-- or proxy#, or undefined

新:

{-# LANGUAGE AllowAmbiguousTypes, TypeApplications #-}

现在您使用显式类型应用程序在调用站点设置 name(还要确保 name 在 class 头中排在第一位,否则类型参数的顺序会搞砸的)。

lensOf @"field"

更完整的例子:

{-# LANGUAGE AllowAmbiguousTypes
           , DataKinds
           , FlexibleContexts
           , FlexibleInstances
           , FunctionalDependencies
           , NoMonomorphismRestriction
           , PolyKinds
           , ScopedTypeVariables
           , TypeApplications
#-}

import Control.Lens

class HasLens x s t a b | x s -> a, x t -> b, x s b -> t, x t a -> s where
  lensOf :: Functor f => (a -> f b) -> s -> f t

data Tup2 a b = Tup2 { _left2 :: a, _right2 :: b } deriving Show
data Tup3 a b c = Tup3 { _left3 :: a, _middle3 :: b, _right3 :: c } deriving Show

instance HasLens "left" (Tup2 a b) (Tup2 a' b) a a' where
  lensOf = lens _left2 $ \t x -> t { _left2 = x }

instance HasLens "left" (Tup3 a b c) (Tup3 a' b c) a a' where
  lensOf = lens _left3 $ \t x -> t { _left3 = x }

instance HasLens "right" (Tup2 a b) (Tup2 a b') b b' where
  lensOf = lens _right2 $ \t x -> t { _right2 = x }

instance HasLens "right" (Tup3 a b c) (Tup3 a b c') c c' where
  lensOf = lens _right3 $ \t x -> t { _right3 = x }

swap' :: forall xlr xrl l r xll xrr. (HasLens "left" xlr xrr l r, HasLens "right" xlr xll r l, HasLens "left" xll xrl l r, HasLens "right" xrr xrl r l) => xlr -> xrl
swap' x = x & lensOf @"left"  .~ x^#lensOf @"right" @xlr @xll @r @l
            & lensOf @"right" .~ x^#lensOf @"left"  @xlr @xrr @l @r

main = do out $ Tup2 5 6
          out $ Tup3 'l' 'm' 'r'
          out $ Tup2 "l" 'r'
          out $ Tup3 17 [5,10] "a"
  where out = print . swap'