Question

说我有一个类型类：

data Proxy a = Proxy
class Fixed a where 
  fixed :: Proxy a -> Int

fixed的定义非常简单，因此我使用GHC.Generics推导出来：

class GFixed f where 
  gfixed :: Proxy (f a) -> Int

instance (GFixed f, GFixed g) => GFixed (f :*: g) where ...

instance (GFixed f, GFixed g) => GFixed (f :+: g) where ...

instance GFixed f => GFixed (M1 i c f) where ...

instance Fixed a => GFixed (K1 i a) where ...

....

default fixed :: (Generic a, GFixed (Rep a)) => Proxy a -> Int
fixed _ = fixed (Proxy :: Proxy (Rep a b))

我没有为GFixed U1添加实例，因为拥有实例没有意义对于void类型，Fixed。我对Generics机制的理解不是很好 - 具体来说，M1和K1的类型是什么意思。问题如下：我可以在类型级别限制GFixed，以便fixed的默认定义不适用于递归类型吗？

例如，如果我写：

data Void
instance Fixed Void

我收到类型错误：No instance for (GFixed V1)。我希望instance Fixed [Int]之类的内容出现类型错误。

Answer 1

documentation对构造函数的含义有一定的帮助。 M1指定元信息（例如记录选择器的名称），而K1是各种类型的*的抓包。如果要禁止所有递归，则需要确保范围中的实例不匹配K1 R a。您仍然希望范围内有一些其他K个实例，因此您应该更改

instance Fixed a => GFixed (K1 i a) where

到

instance Fixed a => GFixed (K1 P a) where

我不知道是否有其他值可以作为K1的第一个参数，但如果有任何值，则添加它们应该是安全的，当然除了K1 R。

Answer 2

经过一些工作后，事实证明这很简单，它甚至适用于相互递归的类型。我确定有一些边缘情况会失败，但我还没有找到。

{-# LANGUAGE 
    MultiParamTypeClasses
  , FunctionalDependencies
  , DataKinds
  , TypeOperators
  , TypeFamilies
  , FlexibleContexts
  , FlexibleInstances
  , UndecidableInstances
  , PolyKinds
  , ConstraintKinds
  , DeriveGeneric
  , OverlappingInstances
  #-}

module IsRecursive where 

import GHC.Generics
import Data.Proxy 

type family (:||) (a :: Bool) (b :: Bool) :: Bool where 
  True :|| x = True
  x :|| True = True
  a :|| b = False 

data T2 a b 

type family Elem (x :: k) (xs :: [k]) :: Bool where 
  Elem x '[] = False
  Elem x (x ': xs) = True
  Elem x (y ': xs) = Elem x xs 

class IsRecursive' (tys :: [* -> *]) (rep :: * -> *) (r :: *) | tys rep -> r where 
  isRecursive' :: Proxy tys -> Proxy rep -> Proxy r
  isRecursive' _ _ = Proxy 

-- These types have recursive `Rep`s but aren't recursive because there is no `Rep` for primitive types
instance IsRecursive' tys (K1 R Int)    (T2 False tys)
instance IsRecursive' tys (K1 R Double) (T2 False tys)
instance IsRecursive' tys (K1 R Char)   (T2 False tys)
instance IsRecursive' tys (K1 R Float)  (T2 False tys)

-- Recursive instances - unwrap one layer of `Rep` and look inside
instance IsRecursive' tys U1 (T2 False tys)
instance IsRecursive' tys (Rep c) r => IsRecursive' tys (K1 i c) r 
instance (IsRecursive' tys f (T2 r0 tys0), IsRecursive' tys g (T2 r1 tys1), r2 ~ (r0 :|| r1)) => IsRecursive' tys (f :+: g) (T2 r2 tys1)
instance (IsRecursive' tys f (T2 r0 tys0), IsRecursive' tys g (T2 r1 tys1), r2 ~ (r0 :|| r1)) => IsRecursive' tys (f :*: g) (T2 r2 tys1)
instance (IsRecursive' tys f r) => IsRecursive' tys (M1 i c f) r 

-- This is where the magic happens 
-- Datatype declaration reps are represented as `M1 D` 
-- When one is encountered, save it in the list so far and continue recursion
instance (IsRecDataDec (Elem tyrep tys) tyrep tys f r, tyrep ~ (M1 D c f)) => IsRecursive' tys (M1 D c f) r

-- Context reduction is strict, so this class makes sure we 
-- only recurse if `Elem tyrep tys == False`; otherwise every recursive type
-- would cause a stack overflow
class IsRecDataDec (b :: Bool) (c :: * -> *) (tys :: [* -> *]) (f :: * -> *) (r :: *) | b c tys f -> r 
instance IsRecDataDec True c tys f (T2 True (c ': tys))
instance IsRecursive' (c ': tys) f r => IsRecDataDec False c tys f r 

class IsRecursive t 
instance IsRecursive' '[] (Rep t) (T2 True tys) => IsRecursive t

data TBool (b :: Bool) = TBool
instance Show (TBool True) where show _ = "True"
instance Show (TBool False) where show _ = "False"

isRecursive :: IsRecursive' '[] (Rep t) (T2 r tys) => t -> TBool r
isRecursive _ = TBool

-- test cases
data K = K K deriving Generic
data A = A B deriving Generic
data B = B Q deriving Generic
data Q = Q A deriving Generic

使用GHC.Generics来限制泛型函数域

2 个答案: