使用 GHC 泛型,我们可以定义仅依赖于类型结构(构造函数的数量及其参数)的操作。
我们想要一个函数zipWithP,它接受一个函数f,并在匹配字段之间压缩两个应用f的元组。也许签名匹配的东西:
zipWithP
:: forall c s. _
=> (forall s. c s => s -> s -> s) -> a -> a -> a
这里f :: forall s. c s => s -> s -> s是多态的,允许元组是异构的,只要字段都是c的实例。该要求将被_ 约束捕获,这取决于实现,只要它有效。
有些库可以捕获常见的结构,特别是 one-liner 和 generics-sop。
按照自动化的递增顺序...
经典的解决方案是使用GHC.Generics 模块。 Generic 实例表示用户定义类型 a 和与之关联的“通用表示”Rep a 之间的同构。
此通用表示由GHC.Generics 中定义的一组固定类型构成。 (该模块的文档中包含有关该表示的更多详细信息。)
标准步骤是:
在该固定类型集(可能是它的子集)上定义函数;
通过使用Generic 实例给出的同构使它们适应用户定义的类型。
第 1 步通常是一个类型类。这里GZipWith 是可以压缩的通用表示类。这里处理的类型构造函数按重要性降序排列:
-
K1 代表字段(只需申请f);
-
(:*:) 代表类型产品(分别压缩操作数);
-
M1 newtype 携带类型级别的信息,我们在这里没有使用这些信息,因此我们只需对其进行包装/解包;
-
U1 代表空构造函数,主要是为了完整性。
第 2 步定义zipWithP,在适当的情况下将gZipWith 与from/to 组合在一起。
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import GHC.Generics
class GZipWith c f where
gZipWith :: (forall s. c s => s -> s -> s) -> f p -> f p -> f p
instance c a => GZipWith c (K1 _i a) where
gZipWith f (K1 a) (K1 b) = K1 (f a b)
instance (GZipWith c f, GZipWith c g) => GZipWith c (f :*: g) where
gZipWith f (a1 :*: a2) (b1 :*: b2) = gZipWith @c f a1 b1 :*: gZipWith @c f a2 b2
instance GZipWith c f => GZipWith c (M1 _i _c f) where
gZipWith f (M1 a) (M1 b) = M1 (gZipWith @c f a b)
instance GZipWith c U1 where
gZipWith _ _ _ = U1
zipWithP
:: forall c a. (Generic a, GZipWith c (Rep a))
=> (forall s. c s => s -> s -> s) -> a -> a -> a
zipWithP f a b = to (gZipWith @c f (from a) (from b))
main = do
print (zipWithP @Num (+) (1,2) (3,4) :: (Int, Integer))
generics-sop 提供高级组合器以进行通用编程,其操作感觉类似于 fmap/traverse/zip...
在这种情况下,相关的组合子是hcliftA2,它使用二进制函数压缩字段的通用异构元组。代码后有更多解释。
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative (liftA2)
import Data.Proxy (Proxy(..))
import Generics.SOP
zipWithP
:: forall c a k
. (Generic a, Code a ~ '[k], All c k)
=> (forall s. c s => s -> s -> s) -> a -> a -> a
zipWithP f x y =
case (from x, from y) of
(SOP (Z u), SOP (Z v)) ->
to (SOP (Z (hcliftA2 (Proxy :: Proxy c) (liftA2 f) u v)))
main = do
print (zipWithP @Num (+) (1,2) (3,4) :: (Int, Integer))
从zipWithP的顶部开始。
约束:
-
Code a ~ '[k]:a 必须是单构造函数类型(Code a :: [[*]] 是 a 的构造函数列表,每个都作为其字段列表给出)。
-
All c k:构造函数k的所有字段都满足约束c。
主体:
-
from 从常规类型 a 映射到通用的产品总和 (SOP I (Code a))。
- 我们假设
a 类型只有一个构造函数。我们通过模式匹配应用这些知识来摆脱“总和”层。我们得到u 和v,它们的类型是products (NP I k)。
- 我们应用
hcliftA2 压缩u 和v 两个元组。
- 字段被封装在类型构造函数
I/Identity(functor-functor 或HKD 样式)中,因此在f 之上还有一个liftA2 层。
- 我们得到一个新元组,并从前两步倒退,通过应用构造函数和
to(from 的倒数)。
有关更多详细信息,请参阅 generics-sop 文档。
zipWithP 属于通常描述为“为每个字段执行此操作”的一类操作。 one-liner 导出操作,其中一些名称可能看起来很熟悉(map...、traverse...),它们本质上是与任何泛型类型关联的单个“广义遍历”的特化。
特别是,zipWithP 被称为binaryOp。
{-# LANGUAGE TypeApplications #-}
import Generics.OneLiner
main = print (binaryOp @Num (+) (1,2) (3,4) :: (Int, Integer))