受限透镜（Constrained lenses）：能否实现仅设置时带C a约束的类透镜结构？

当然可以实现这种仅在执行设置操作时才引入C a约束的透镜结构，下面分别给出Van Laarhoven风格和Profunctor风格的具体实现：

Van Laarhoven风格 #

Van Laarhoven风格的透镜依赖函子多态性，我们可以利用这一点让读取操作不受约束，仅在设置时触发C a约束：

首先定义透镜的类型：

type LensXY a = forall f. Functor f => (Y a -> f (Y a)) -> X a -> f (X a)

接着实现这个透镜：

xyLens :: LensXY a
xyLens f x = fmap (\newY -> setXY x newY) (f (getXY x))

操作验证 #

• 读取（get）：使用Const函子完成读取，全程不需要C a约束：

  view :: LensXY a -> X a -> Y a
  view lens = getConst . lens Const
  -- 调用：view xyLens someX  // 无C a约束
  

• 设置（set）：使用Identity函子完成设置，此时会触发setXY的C a约束：

  set :: C a => LensXY a -> Y a -> X a -> X a
  set lens newY x = runIdentity . lens (const (Identity newY)) $ x
  -- 调用：set xyLens newY someX  // 需要C a约束
  

Profunctor风格 #

Profunctor风格的光学结构通过profunctor的多态性抽象读写行为，同样能实现仅在设置时引入约束的效果：

基于Star Profunctor的实现 #

Star profunctor可以很好地封装带上下文的函数，我们可以直接针对它实现：

import Data.Profunctor.Unsafe (Star(..))

xyLensP :: C a => Star Identity (Y a) (Y a) -> Star Identity (X a) (X a)
xyLensP (Star f) = Star $ \x -> do
  currentY <- f (getXY x)
  return $ setXY x currentY

通用Strong Profunctor实现 #

如果需要更通用的profunctor支持，可以利用Strong类型类（它支持拆分和重组数据结构），此时约束会在使用需要设置能力的profunctor时自动触发：

import Data.Profunctor (Profunctor(..), Strong(..))

xyLensP :: (Strong p, C a) => p (Y a) (Y a) -> p (X a) (X a)
xyLensP = dimap getXY (\x y -> setXY x y) . first'

操作验证 #

• 读取操作：使用Star (Const r)作为profunctor，仅用到getXY，无需C a约束：

  viewP :: (Profunctor p, Functor (p (Y a))) => p (Y a) r -> X a -> r
  viewP p x = getConst . runStar (xyLensP (Star (Const . flip runStar x))) $ ()
  

• 设置操作：使用Star Identity作为profunctor，此时会触发setXY的C a约束：

  setP :: C a => Y a -> X a -> X a
  setP newY = runIdentity . runStar (xyLensP (Star (const (Identity newY))))
  

内容的提问来源于stack exchange，提问作者dfeuer