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

Question

可以将 classes 与镜头混合使用，以模拟过载的记录字段，直至达到一定程度。例如，参见 Control.Lens.TH 中的 makeFields。我想弄清楚是否有一种很好的方法可以为某些类型重用与 lens 相同的名称，为其他类型重用 traversal 。值得注意的是，给定产品总和，每个产品都可以有透镜，这将降级为总和的遍历。我能想到的最简单的事情是这个**：

第一次尝试

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:

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 产生了 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，但每次我们想要这样做，我们都必须首先拖入它确实是一个的证据。当然，这far对于实现重载记录字段的目的来说太不方便了！有没有更好的方法？

** 此代码使用以下内容编译（可能不是最小的）：

{-# 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

它也可以扩展到多态字段，如果我们确保强制执行所有相关的函数依赖（就像 here）。让重载的字段完全多态几乎没有用，也不是什么好主意；不过，我说明了这种情况，因为从那里总是可以根据需要进行单态化（或者我们可以限制多态字段，例如 name 字段到 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

也可以有点疯狂，使用单个 class 来实现所有 "has" 功能：

{-# 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}

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

How can I use overloaded record fields with lenses?

haskell

typeclass

haskell-lens

第一次尝试

第二次尝试

为什么这仍然很糟糕