haskell - 在 Haskell 中使用泛型获取构造函数索引

Question

我想使用泛型实现以下类型类:

class HasIndex a where
   getIndex :: a -> Int

因此，对于给定的数据类型

{-# LANGUAGE DeriveGenerics #-}

import GHC.Generics
import Data.Binary    

data Test = Foo Int | Bar deriving (Generic)
instance Binary Test
instance HasIndex Test

通话

getIndex $ Foo 1

应该返回 0。并且

getIndex Bar

应该返回1。这可能吗？

Answer 1

请注意，在同一程序中同时使用 Data 和 Generic 泛型并没有真正的问题，有时 - 正如这里 - Data 更方便。

无论如何，这是一个纯粹的通用解决方案的想法。正如 GHC.Generics 中所述，一般方法是定义一个通用函数:

getIndex :: (Generic a, GetIndex' (Rep a)) => a -> Int
getIndex = getIndex' . from

分派(dispatch)到表示上适当的 GetIndex' 实例，然后为所有泛型构造函数定义 GetIndex' 实例。

假设我们从一个类开始:

class GetIndex' f where
  getIndex' :: f p -> Int

并尝试定义(:+:)实例。如果提供的值位于左侧，这很容易，因为 f :+: g 中的索引将只是 f 中的索引，因此我们有:

instance (GetIndex' f, GetIndex' g) => GetIndex' (f :+: g) where
  getIndex' (L1 x) = getIndex' x

但是，当我们尝试为右侧定义它时，我们遇到了一个问题:

  getIndex' (R1 x) = <<size f>> + getIndex' x

我们需要根据其表示形式f计算左侧的大小。执行此操作的标准方法是定义一个采用代理参数的 size 方法，因此我们将修改我们的类，使其如下所示:

class GetIndex' f where
  getIndex' :: f p -> Int
  size :: Proxy f -> Int

现在，我们可以写:

instance (GetIndex' f, GetIndex' g) => GetIndex' (f :+: g) where
  getIndex' (L1 x) = getIndex' x
  getIndex' (R1 x) = size (Proxy @f) + getIndex' x
  size _ = size (Proxy @f) + size (Proxy @g)

乘积项 (:*:) 以及单位项 U1 和 K1 都将代表单构造函数的情况，因此它们将都有相似的实例:

instance GetIndex' U1 where
  getIndex' _ = 0
  size _ = 1

完整的程序如下所示:

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

import GHC.Generics
import Data.Proxy

class GetIndex' f where
  getIndex' :: f p -> Int
  size :: Proxy f -> Int
instance (GetIndex' f) => GetIndex' (M1 i t f) where
  getIndex' (M1 x) = getIndex' x
  size _ = size (Proxy @f)
instance GetIndex' V1 where
  getIndex' v = case v of
  -- Unused, but consistent
  size _ = 0
instance (GetIndex' f, GetIndex' g) => GetIndex' (f :+: g) where
  getIndex' (L1 x) = getIndex' x
  getIndex' (R1 x) = size (Proxy @f) + getIndex' x
  size _ = size (Proxy @f) + size (Proxy @g)
instance GetIndex' (f :*: g) where
  getIndex' _ = 0
  size _ = 1
instance GetIndex' (K1 i c) where
  getIndex' _ = 0
  size _ = 1
instance GetIndex' U1 where
  getIndex' _ = 0
  size _ = 1

getIndex :: (Generic a, GetIndex' (Rep a)) => a -> Int
getIndex = getIndex' . from

data Test = Foo Int | Bar deriving (Generic)

main = do
  print $ getIndex (Foo 999)
  print $ getIndex Bar