如何使用镜头消除包裹和展开的样板

How to eliminate the boilerplate of wrapping and unwrapping using lenses

tl;dr:是否可以使用任何 lens 抽象家族来 wrap/unwrap 任意 newtype(即为此类抽象提供实例)?

我将通过一个基于真实故事的简单示例来激发我的问题。假设我定义了以下 newtype:

newtype FreeMonoid a = FreeMonoid { asMap :: Map a Int }

用于表示以下形式的术语:

a0 <> a1 <> ... <> an-1

我们可以将自由幺半群表示为列表:

instance Ord a => IsList (FreeMonoid a) where
    type Item (FreeMonoid a) = a
    fromList xs = FreeMonoid $ Map.fromListWith (+) $ zip xs (repeat 1)
    toList (FreeMonoid p) = do
        (x, n) <- Map.toList p
        genericReplicate n x

自由幺半群的两个例子是和序列和乘积序列:

type FreeSum a = FreeMonoid (Sum a)
type FreeProduct a = FreeMonoid (Product a)

其中 SumProductData.Monoid 中定义。现在我们可以为 FreeSumfromListtoList 操作定义 FreeProduct如下:

fromListSum :: Ord a => [a] -> FreeSum a
fromListSum = fromList . (Sum <$>)

fromListProduct :: Ord a => [a] -> FreeProduct a
fromListProduct = fromList . (Product <$>)  

但这有很多样板文件。如果我们可以简单地说就更好了:

fromListW :: (Ord a, Wrapper f) => [a] -> FreeMonoid (f a)
fromListW = fromList . (wrap <$>)

其中 wrap 是(假设的)Wrapper class 的一些操作:

wrap :: a -> f a
unwrap :: f a -> a

同样,我希望能够编写一个函数:

toListW :: (Ord a, Wrapper f) => FreeMonoid (f a) -> [a]
toListW = (unwrap <$>) . toList

Lenses 似乎在 Control.Lens.Wrapped 中提供了这样的抽象(本例中的 SumProduct 是类型 class 的实例!)。然而,我试图理解和使用这个模块中的抽象概念却失败了。例如:

fromListW :: (Ord a, Wrapped (f a))  => [a] -> FreeMonoid (f a)
fromListW = fromList . (Wrapped <$>)

将不起作用,因为参数不是 Unwrapped (f a).

的列表

所以我的问题是:

"problem" 是您使用的 Wrapped,它实际上是一个方便的模式同义词,而不是包装 "constructor"。因为它被设计为支持多态包装,所以你需要断言你的类型可以被重新包装:

fromListW :: (Rewrapped a a, Ord a) => [Unwrapped a] -> FreeMonoid a
fromListW = fromList . (Wrapped <$>)

这会按预期工作:

> let x = [1,2,3]
> fromListW x :: FreeMonoid (Sum Int)
FreeMonoid {asMap = fromList [(Sum {getSum = 1},...
> fromListW x :: FreeMonoid (Product Int)
FreeMonoid {asMap = fromList [(Product {getProduct = 1},...
>

我认为更惯用的镜头实现是:

fromListW :: (Rewrapped a a, Ord a) => [Unwrapped a] -> FreeMonoid a
fromListW = fromList . view (mapping _Unwrapped)

这仍然需要 Rewrapped a a 约束,但您可以使用非多态 _Unwrapped' 代替:

fromListW :: (Wrapped a, Ord a) => [Unwrapped a] -> FreeMonoid a
fromListW = fromList . view (mapping _Unwrapped')

看起来更自然一些。

toListW 实现将具有类似的结构:

toListW :: (Wrapped a, Ord a) => FreeMonoid a -> [Unwrapped a]
toListW = view (mapping _Wrapped') . toList