GHC Generics:如何编写(:+ :)的实现,将和类型从/转换为整数?

时间:2015-08-20 00:23:53

标签: haskell ghc

我想写一个

的实现

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是{{1}的构造函数接受一个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的无效构造函数。

1 个答案:

答案 0 :(得分:3)

诀窍是创建另一个计算构造函数数量的类

{-# 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课程,我们可以充实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]

AF被映射到数字05。阅读这些数字会再现AF。尝试读取该范围之外的数字会产生Nothing

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