GHC 泛型：如何编写 (:+:) 的实现来转换总和类型 from/to 整数？

Question

我想写一个

的实现

instance (GMySerialize a, GMySerialize b) => GMySerialize (a :+: b)

其中 GMySerialize 定义为：

class GMySerialize f where
    gtoMyS :: f a -> MySerialize
    gfromMyS :: MySerialize -> Maybe (f a)

对于任何仅由 nullary 数据构造函数（例如 data MyType = A | B | C | D | E | f）组成的总和类型，它将与 MySerializeInt 相互转换，其中 MySerializeInt 是 MySerialize 接受一个 int 参数。

我从

开始

instance (GMySerialize a, GMySerialize b) => GMySerialize (a :+: b) where
   gtoMyS (L1 x) = MySerializeInt (0 + rest)
     where rest = case gtoMyS x of
             MySerializeInt n -> n
             MySerializeNil -> 0
             err -> error $ show err
   gtoMyS (R1 x) = MySerializeInt (1 + rest)
     where rest = case gtoMyS x of
             MySerializeInt n -> n
             MySerializeNil -> 0
             err -> error $ show err

但意识到这是非常错误的，我不确定如何解决它。怎么错了？例如，以下产生相同的整数，但它们不应该因为它们代表不同的构造函数：

M1 {unM1 = L1 (R1 (M1 {unM1 = U1}))}
M1 {unM1 = R1 (L1 (M1 {unM1 = U1}))}

我也不确定如何编写 gfromMyS 个实例，即使我 gtoMyS 可以正常工作。

换句话说，我想要做的事情与编写模板 Haskell 函数具有等效的效果，该函数生成：

instance MySerialize t where
  toMyS x = MySerializeInt (toEnum x)
  fromMyS (MySerializeInt n) -> Just (fromEnum n)
  fromMyS _ -> Nothing

对于每个 t，其中 t 是仅具有实现 Enum 的 nullary 构造函数的总和类型。

Answer 1

诀窍是制作另一个 class 来计算构造函数的数量

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}

import Data.Functor ((<$>))
import Data.Tagged

import GHC.Generics

class GNumConstructors (f :: * -> *) where
    -- Is this close enough to CAF to get memoed in the dictionary?
    gnumConstructors :: Tagged f Int

instance GNumConstructors (M1 C c f) where
    gnumConstructors = Tagged 1

instance (GNumConstructors a, GNumConstructors b) => GNumConstructors (a :+: b) where
    gnumConstructors = Tagged $ unTagged (gnumConstructors :: Tagged a Int) +  unTagged (gnumConstructors :: Tagged b Int)

然后你可以很容易地把左边的整数（小于左边的可能性数）和右边的整数（任何更大的数）分开。

type MyS = Int

class GMySerialize f where
    gtoMyS :: f a -> MyS
    gfromMyS :: MyS -> Maybe (f a)

instance (GNumConstructors a, GMySerialize a, GMySerialize b) => GMySerialize (a :+: b) where
    gtoMyS (L1 l) = gtoMyS l
    gtoMyS (R1 r) = unTagged (gnumConstructors :: Tagged a Int) + gtoMyS r

    gfromMyS x = if x < unTagged (gnumConstructors :: Tagged a Int)
                 then L1 <$> gfromMyS x
                 else R1 <$> gfromMyS (x - unTagged (gnumConstructors :: Tagged a Int))

任何单独的构造函数都由 0 表示，我们直接查看元数据。

instance GMySerialize U1 where
    gtoMyS U1 = 0
    gfromMyS 0 = Just U1
    gfromMyS _ = Nothing

instance GMySerialize f => GMySerialize (M1 i c f) where
    gtoMyS (M1 a) = gtoMyS a
    gfromMyS ms = M1 <$> gfromMyS ms

结合 MySerialize class 我们可以充实 MyType 的完整示例并进行测试

class MySerialize a where
    toMyS :: a -> MyS
    fromMyS :: MyS -> Maybe a

    default toMyS :: (Generic a, GMySerialize (Rep a)) => a -> MyS
    toMyS a = gtoMyS $ from a

    default fromMyS :: (Generic a, GMySerialize (Rep a)) => MyS -> Maybe a
    fromMyS a = to <$> gfromMyS a

data MyType = A | B | C | D | E | F
    deriving (Generic, Show)

instance MySerialize MyType

main = do
    print . map toMyS $ [A, B, C, D, E, F]
    print . map (fromMyS :: MyS -> Maybe MyType) $ [-1, 0, 1, 2, 3, 4, 5, 6]

A 到 F 映射到数字 0 到 5。读取这些数字会重现 A 到 F。尝试读取超出该范围的数字会产生 Nothing.

[0,1,2,3,4,5]
[Nothing,Just A,Just B,Just C,Just D,Just E,Just F,Nothing]

GHC 泛型：如何编写 (:+:) 的实现来转换总和类型 from/to 整数？

GHC Generics: How to write an implementation of (:+:) that converts sum types from/to integers?

haskell

ghc