是否有可能重新实现使用GHC泛型得出的"Enum"

Question

是否有可能Enum使用GHC泛型重新实现类型类的派生？

起初,它看起来很简单:

data Foo -- representation without metadata (wrong):
  = Foo  -- L1 U1
  | Bar  -- R1 (L1 U1)
  | Baz  -- R1 (R1 (L1 U1))
  | Quux -- R1 (R1 (R1 U1))
  deriving (Show, Eq, Generic)

-- Rep Foo p = (U1 :+: (U1 :+: (U1 :+: U1))) p

instance Enum Foo where
  toEnum   = undefined -- FIXME
  fromEnum = gfromEnum . from

class GEnum f where
  gfromEnum :: f p -> Int

instance GEnum U1 where
  gfromEnum U1 = 0

instance GEnum f => GEnum (M1 i t f) where
  gfromEnum (M1 x) = gfromEnum x

instance (GEnum x, GEnum y) => GEnum (x :+: y) where
  gfromEnum (L1 x) = gfromEnum x
  gfromEnum (R1 y) = 1 + gfromEnum y

但是,这不会起作用:

?> fromEnum Foo
0
?> fromEnum Bar
1
?> fromEnum Baz
1
?> fromEnum Quux
2

这是因为我们不能依赖于如何对参数(:+:)进行分组.在这种情况下,似乎它们嵌套如下:

((U1 :+: U1) :+: (U1 :+: U1)) p

那么,是否可以推导出Enum使用Generics？如果有,怎么样？

Answer 1

GHC 的推导Generic使得 L 和 R 变体形成一棵树，其中叶子是有序的Enum。考虑以下示例（已修剪输出）：

ghci> data D = A | B | C | D | E deriving (Generic)
ghci> from A
L1 (L1 U1)
ghci> from B
L1 (R1 U1)
ghci> from C
R1 (L1 U1)
ghci> from D
R1 (R1 (L1 U1))
ghci> from E
R1 (R1 (R1 U1)))

请注意，如果您将它们排列为树，toEnum `map` [1..]则将从左到右遍历叶子。有了这种直觉，我们将首先定义一个GLeaves类，该类计算泛型类型（不是值！）在其树中的叶子数量。

{-# LANGUAGE ScopedTypeVariables, PolyKinds, TypeApplications, TypeOperators,
             DefaultSignatures, FlexibleContexts, TypeFamilies #-}

import GHC.Generics
import Data.Proxy

class GLeaves f where
  -- | Counts the number of "leaves" (i.e. U1's) in the type `f`
  gSize :: Proxy f -> Int

instance GLeaves U1 where
  gSize _ = 1

instance GLeaves x => GLeaves (M1 i t x) where
  gSize _ = gSize (Proxy :: Proxy x)

instance (GLeaves x, GLeaves y) => GLeaves (x :+: y) where
  gSize _ = gSize (Proxy :: Proxy x) + gSize (Proxy :: Proxy y)

现在，我们已经可以定义 了GEnum。与此设置一样，我们定义类Enum'并具有依赖于GEnum.

class Enum' a where
  toEnum' :: Int -> a
  fromEnum' :: a -> Int

  default toEnum' :: (Generic a, GEnum (Rep a)) => Int -> a
  toEnum' = to . gToEnum

  default fromEnum' :: (Generic a, GEnum (Rep a)) => a -> Int
  fromEnum' = gFromEnum . from

class GEnum f where
  gFromEnum :: f p -> Int
  gToEnum :: Int -> f p

最后，我们来看看好东西。对于U1和M1，gFromEnum和gToEnum都很简单。对于:+:，gFromEnum需要找到其左侧的所有叶子，因此如果它是右子树，我们添加左子树的大小（如果它是左子树，我们不添加任何内容）。类似地，gToEnum，通过检查它是否小于左子树中的叶子数来检查它属于左子树还是右子树。

instance GEnum U1 where
  gFromEnum U1 = 0

  gToEnum n = if n == 0 then U1 else error "Outside enumeration range"

instance GEnum f => GEnum (M1 i t f) where
  gFromEnum (M1 x) = gFromEnum x

  gToEnum n = M1 (gToEnum n)

instance (GLeaves x, GEnum x, GEnum y) => GEnum (x :+: y) where
  gFromEnum (L1 x) = gFromEnum x
  gFromEnum (R1 y) = gSize (Proxy :: Proxy x) + gFromEnum y

  gToEnum n = let s = gSize (Proxy :: Proxy x)
              in if n < s then L1 (gToEnum n) else R1 (gToEnum (n - s))

最后，您可以在 GHCi 中进行测试：

ghci> :set -XDeriveAnyClass -XDeriveGeneric
ghci> data D = A | B | C | D | E deriving (Show, Generic, Enum, Enum')
ghci> toEnum `map` [0 .. 4] :: [D]
[A,B,C,D,E]
ghci> toEnum' `map` [0 .. 4] :: [D]
[A,B,C,D,E]
ghci> fromEnum `map` [A .. E] :: [Int]
[A,B,C,D,E]
ghci> fromEnum' `map` [A .. E] :: [Int]
[A,B,C,D,E]

表现

你可能会想：这效率太低了！我们最终一遍又一遍地重新计算一堆尺寸 - 最坏情况下的性能至少是O(n^2)。问题是（希望）GHC 将能够优化/内联我们的特定实例，Enum'直到初始Generic结构中没有任何剩余。