使用GHC.Generics派生默认实例

Question

我有一个类型类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相当于id这里.grot重新审视(:+:)结构,T3直到它击中基础案例grot U1 = U1.

有人建议#haskell使用构造函数信息,M1因此grot可以选择下一个构造函数来进行递归,但我不知道如何做到这一点.

是否有可能生成所需的Cyclic使用实例GHC.Generics或其他形式的Scrap Your Boilerplate？

编辑:我可以Cyclic用Bounded和写Enum

class 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)

但是(原样)这是令人不满意的,因为它需要所有的Bounded,Enum和Eq.另外,Enum在某些情况下,GHC不能自动导出,而更强大的Generic可以.

Answer 1

重读后ord应该编辑的意思,再次尝试解决两个循环问题的产物

你可以知道什么时候去一个构造函数的另一边,如果你能分辨出里面的内容已经在最后一个构造函数,这就是new end和gend 函数的作用.我无法想象一个我们无法定义的循环群end.

你gord甚至可以在不检查值的情况下实现求和; 该ScopedTypeVariables扩展有助于此.我已经将签名更改为使用代理,因为您现在正在混合undefined并尝试解构代码中的值.

import Data.Proxy

这是Cyclic类end,默认和Integral n(而不是假设Int)forord

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 ()))

以下是一些示例实例:

-- 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 []

第四个和第五个例子展示了当我们为两个循环组的产品创建实例时发生的事情,这两个循环组的顺序不是互质的.