haskell - 如何在镜头中使用过载的记录场？

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产生 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

如果我们确保强制执行所有相关的函数依赖关系(就像 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

也可以有点狂野，为所有“拥有”功能使用一个类:

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