使用GHC.Generics派生默认实例

时间:2014-04-03 23:39:38

标签: haskell generic-programming deriving scrap-your-boilerplate

我有一个类型Cyclic,我希望能够为其提供通用实例。

class Cyclic g where
    gen :: g
    rot :: g -> g
    ord :: g -> Int

给定一个nullary构造函数的总和类型,

data T3 = A | B | C deriving (Generic, Show)

我想生成一个与此相当的实例:

instance Cyclic T3 where
    gen   = A
    rot A = B
    rot B = C
    rot C = A
    ord _ = 3

我试图找出所需的Generic机器

{-# LANGUAGE DefaultSignatures, FlexibleContexts, ScopedTypeVariables, TypeOperators #-}

import GHC.Generics

class GCyclic f where
    ggen :: f a
    grot :: f a -> f a
    gord :: f a -> Int

instance GCyclic U1 where
    ggen   = U1
    grot _ = U1
    gord _ = 1

instance Cyclic c => GCyclic (K1 i c) where
    ggen = K1 gen
    grot (K1 a) = K1 (rot a)
    gord (K1 a) = ord a

instance GCyclic f => GCyclic (M1 i c f) where
    ggen = M1 ggen
    grot (M1 a) = M1 (grot a)
    gord (M1 a) = gord a    

instance (GCyclic f, GCyclic g) => GCyclic (f :*: g) where
    ggen = ggen :*: ggen
    grot (a :*: b) = grot a :*: grot b
    gord (a :*: b) = gord a `lcm` gord b

instance (GCyclic f, GCyclic g) => GCyclic (f :+: g) where
    ggen = L1 ggen
    -- grot is incorrect
    grot (L1 a) = L1 (grot a) 
    grot (R1 b) = R1 (grot b)
    gord _ = gord (undefined :: f a)
           + gord (undefined :: g b)

现在,我可以使用Cyclic

GCyclic提供默认实施
class Cyclic g where
    gen :: g
    rot :: g -> g
    ord :: g -> Int

    default gen :: (Generic g, GCyclic (Rep g)) => g
    gen = to ggen

    default rot :: (Generic g, GCyclic (Rep g)) => g -> g
    rot = to . grot . from

    default ord :: (Generic g, GCyclic (Rep g)) => g -> Int
    ord = gord . from

但我的GCyclic个实例不正确。使用上面的T3

λ. map rot [A, B, C] -- == [B, C, A]
[A, B, C]

很清楚为什么rot等同于idgrot (:+:)递归T3 grot U1 = U1 #haskell结构,直至达到基本情况M1

有人建议在grot上使用Cyclic中的构造函数信息,以便GHC.Generics可以选择下一个构造函数来进行递归,但我不知道该怎么做。

是否可以使用Cyclic或其他形式的Scrap Your Boilerplate生成Bounded的所需实例?

编辑:我 可以<{1}}使用Enumclass Cyclic g where gen :: g rot :: g -> g ord :: g -> Int default gen :: Bounded g => g gen = minBound default rot :: (Bounded g, Enum g, Eq g) => g -> g rot g | g == maxBound = minBound | otherwise = succ g default ord :: (Bounded g, Enum g) => g -> Int ord g = 1 + fromEnum (maxBound `asTypeOf` g)

撰写<{1}}
Bounded

但是(按原样)这是不满意的,因为它需要EnumEqEnum。此外,在某些情况下,GHC无法自动导出Generic,而{{1}}可以使用更强大的{{1}}。

1 个答案:

答案 0 :(得分:5)

重新阅读ord的意思后再编辑,然后再次尝试解决product of two cycles problem

如果可以判断内部的内容是否已经在最后一个构造函数中,那么你可以弄清楚何时转到构造函数总和的另一边,这就是新的endgend函数做。我无法想象一个我们无法定义end的循环群。

您可以在不查看值的情况下为总和实施gord; ScopedTypeVariables扩展程序对此有帮助。我已经更改了使用代理的签名,因为您现在正在混合undefined并尝试解构代码中的值。

import Data.Proxy

Cyclic end Integral n Int类,默认值为ord {而不是class Cyclic g where gen :: g rot :: g -> g end :: g -> Bool ord :: Integral n => Proxy g -> n default gen :: (Generic g, GCyclic (Rep g)) => g gen = to ggen default rot :: (Generic g, GCyclic (Rep g)) => g -> g rot = to . grot . from default end :: (Generic g, GCyclic (Rep g)) => g -> Bool end = gend . from default ord :: (Generic g, GCyclic (Rep g), Integral n) => Proxy g -> n ord = gord . fmap from GCyclic

class GCyclic f where
    ggen :: f a
    gend :: f a -> Bool
    grot :: f a -> f a
    gord :: Integral n => Proxy (f ()) -> n

instance GCyclic U1 where
    ggen   = U1
    grot _ = U1
    gend _ = True
    gord _ = 1

instance Cyclic c => GCyclic (K1 i c) where
    ggen        = K1 gen
    grot (K1 a) = K1 (rot a)
    gend (K1 a) = end a
    gord  _     = ord (Proxy :: Proxy c)

instance GCyclic f => GCyclic (M1 i c f) where
    ggen        = M1    ggen
    grot (M1 a) = M1   (grot a)
    gend (M1 a) = gend  a
    gord  _     = gord (Proxy :: Proxy (f ()))

lcm类及其实现:

gcm

我不能强调,以下是在两个周期的乘积的多个循环子群上进行等价类。由于需要检测总和的结尾,以及[a]-- The product of two cyclic groups is a cyclic group iff their orders are coprime, so this shouldn't really work instance (GCyclic f, GCyclic g) => GCyclic (f :*: g) where ggen = ggen :*: ggen grot (a :*: b) = grot a :*: grot b gend (a :*: b) = gend a && (any gend . take (gord (Proxy :: Proxy (f ())) `gcd` gord (Proxy :: Proxy (g ()))) . iterate grot) b gord _ = gord (Proxy :: Proxy (f ())) `lcm` gord (Proxy :: Proxy (g ())) instance (GCyclic f, GCyclic g) => GCyclic (f :+: g) where ggen = L1 ggen grot (L1 a) = if gend a then R1 (ggen) else L1 (grot a) grot (R1 b) = if gend b then L1 (ggen) else R1 (grot b) gend (L1 _) = False gend (R1 b) = gend b gord _ = gord (Proxy :: Proxy (f ())) + gord (Proxy :: Proxy (g ())) 的计算不是懒惰的面孔,我们再也不能做有趣的事情,比如为{{派生一个循环实例1}}。

-- Perfectly fine instances
instance Cyclic ()
instance Cyclic Bool
instance (Cyclic a, Cyclic b) => Cyclic (Either a b)

-- Not actually possible (the product of two arbitrary cycles is a cyclic group iff they are coprime)
instance (Cyclic a, Cyclic b) => Cyclic (a, b)

-- Doesn't have a finite order, doesn't seem to be a prime transfinite number.
-- instance (Cyclic a) => Cyclic [a]

以下是一些示例实例:

typeOf :: a -> Proxy a
typeOf _ = Proxy

generate :: (Cyclic g) => Proxy g -> [g]
generate _ = go gen
    where
        go g = if end g
               then [g]
               else g : go (rot g)

main = do
    print . generate . typeOf $ A
    print . map rot . generate . typeOf $ A
    putStrLn []

    print . generate $ (Proxy :: Proxy (Either T3 Bool))
    print . map rot . generate $ (Proxy :: Proxy (Either T3 Bool))
    putStrLn []

    print . generate . typeOf $ (A, False)
    print . map rot . generate . typeOf $ (A, False)
    putStrLn []

    print . generate . typeOf $ (False, False)
    print . map rot . generate . typeOf $ (False, False)
    print . take 4 . iterate rot $ (False, True)
    putStrLn []

    print . generate $ (Proxy :: Proxy (Either () (Bool, Bool)))
    print . map rot . generate $ (Proxy :: Proxy (Either () (Bool, Bool)))
    print . take 8 . iterate rot $ (Right (False,True) :: Either () (Bool, Bool))
    putStrLn []

要运行的一些示例代码:

{{1}}

第四个和第五个例子展示了当我们为两个不是互质的循环群的乘积做一个实例时发生了什么。