我想写一个
的实现 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
的无效构造函数。
答案 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]
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]