如何使用带镜头的重载记录字段？

Question

可以将类与镜头混合以模拟重载的记录字段,直到某一点.例如,makeFields参见Control.Lens.TH.我试图弄清楚是否有一种很好的方法可以为某些类型重复使用相同的名称作为镜头,并为其他类型重用遍历.值得注意的是,考虑到产品的总和,每种产品都可以具有透镜,这将降低到总和的遍历.我能想到的最简单的事情就是**:

第一次尝试

class Boo booey where
  type Con booey :: (* -> *) -> Constraint
  boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey

这适用于简单的事情,比如

data Boop = Boop Int Char
instance Boo Boop where
  type Con Boop = Functor
  boo f (Boop i c) = (\i' -> Boop i' c) <$> f i

但是,只要你需要更复杂的东西,它就会落在脸上

instance Boo boopy => Boo (Maybe boopy) where

哪个应该能够产生一个Traversal不管底层的选择Boo.

第二次尝试

我尝试过的下一件事,就是限制Con家庭.这有点粗糙.首先,改变班级:

class LTEApplicative c where
  lteApplicative :: Applicative a :- c a

class LTEApplicative (Con booey) => Boo booey where
  type Con booey :: (* -> *) -> Constraint
  boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey

这使得Boo实例带有明确的证据表明它们boo产生了a Traversal' booey Int.更多东西:

instance LTEApplicative Applicative where
  lteApplicative = Sub Dict

instance LTEApplicative Functor where
  lteApplicative = Sub Dict

-- flub :: Boo booey => Traversal booey booey Int Int
flub :: forall booey f . (Boo booey, Applicative f) => (Int -> f Int) -> booey -> f booey
flub = case lteApplicative of
         Sub (Dict :: Dict (Con booey f)) -> boo

instance Boo boopy => Boo (Maybe boopy) where
  type Con (Maybe boopy) = Applicative
  boo _ Nothing = pure Nothing
  boo f (Just x) = Just <$> hum f x
    where hum :: Traversal' boopy Int
          hum = flub

基础Boop示例不变.

为什么这仍然很糟糕

我们现在已经boo产生了Lens或Traversal在适当的情况下,我们总是可以将它作为一个Traversal,但每次我们想要这样做时,我们必须首先拖入它确实是一个的证据.这是当然的,远远实现重载记录字段的目的太不方便了!有没有更好的方法？

**此代码汇编以下内容(可能不是最小值):

{-# LANGUAGE PolyKinds, TypeFamilies,
     TypeOperators, FlexibleContexts,
     ScopedTypeVariables, RankNTypes,
     KindSignatures #-}

import Control.Lens
import Data.Constraint

Answer 1

以下内容之前对我有用：

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

import Control.Lens

data Boop = Boop Int Char deriving (Show)

class HasBoo f s where
  boo :: LensLike' f s Int

instance Functor f => HasBoo f Boop where
  boo f (Boop a b) = flip Boop b <$> f a

instance (Applicative f, HasBoo f s) => HasBoo f (Maybe s) where
  boo = traverse . boo

如果我们确保强制执行所有相关的函数依赖项（就像这里一样），它也可以扩展到多态字段。让重载字段完全多态几乎没有用处，也不是一个好主意。我说明了这种情况，因为从那里开始，我们总是可以根据需要进行单态化（或者我们可以限制多态字段，例如字段nameto IsString）。

{-# LANGUAGE
  UndecidableInstances, MultiParamTypeClasses,
  FlexibleInstances, FunctionalDependencies, TemplateHaskell #-}

import Control.Lens

data Foo a b = Foo {_fooFieldA :: a, _fooFieldB :: b} deriving Show

makeLenses ''Foo

class HasFieldA f s t a b | s -> a, t -> b, s b -> t, t a -> s where
  fieldA :: LensLike f s t a b

instance Functor f => HasFieldA f (Foo a b) (Foo a' b) a a' where
  fieldA = fooFieldA

instance (Applicative f, HasFieldA f s t a b) => HasFieldA f (Maybe s) (Maybe t) a b where
  fieldA = traverse . fieldA

人们还可以采取一些疯狂的做法，对所有“具有”功能使用单个类：

{-# LANGUAGE
  UndecidableInstances, MultiParamTypeClasses,
  RankNTypes, TypeFamilies, DataKinds,
  FlexibleInstances, FunctionalDependencies,
  TemplateHaskell #-}

import Control.Lens hiding (has)
import GHC.TypeLits
import Data.Proxy

class Has (sym :: Symbol) f s t a b | s sym -> a, sym t -> b, s b -> t, t a -> s where
  has' :: Proxy sym -> LensLike f s t a b

data Foo a = Foo {_fooFieldA :: a, _fooFieldB :: Int} deriving Show
makeLenses ''Foo

instance Functor f => Has "fieldA" f (Foo a) (Foo a') a a' where
  has' _ = fooFieldA

使用 GHC 8，可以添加

{-# LANGUAGE TypeApplications #-}

并避免代理：

has :: forall (sym :: Symbol) f s t a b. Has sym f s t a b => LensLike f s t a b
has = has' (Proxy :: Proxy sym)

instance (Applicative f, Has "fieldA" f s t a b) => Has "fieldA" f (Maybe s) (Maybe t) a b where
  has' _ = traverse . has @"fieldA"

例子：

> Just (Foo 0 1) ^? has @"fieldA"
Just 0
> Foo 0 1 & has @"fieldA" +~ 10
Foo {_fooFieldA = 10, _fooFieldB = 1}