Rei*_*ica 6 haskell enumeration routes
我想一般性地导出类似于 Universe根据 ADT 定义的用户路由类型的内容。
问题：我既不能使用Enum/Bounded也不能使用Universe- 因为它们不安全。类似类型的默认实例Int64可能会导致生成无数条路由。
以下路线是有效的，并且应该被接受，因为路线数量较少且有限：
data R = Index | Blog BlogR
data BlogR = Foo | Bar
以下路由无效，不应被接受，因为由于 可以生成无限数量的路由String。Int64也不应该接受有限可枚举类型。
data R = Index | Blog BlogR
data BlogR = Post String
以下路线似乎有效，但由于递归，也不应被接受。
data R = Index | Blog BlogR
data BlogR = Foo | Bar | Rec R
问题：
generics-sop以用户友好的方式失败？TypeErrorIsRoute r => allRoutes :: [r]。目前，我使用Enumand Bounded（请参阅此处的实际代码），这是有限制的，因为它无法处理上面的第一种路由类型。不，没有现有的类型类可以捕获这种类型的约束。
定义基于泛型的答案的挑战似乎是排除递归，如下所示。我认为最简单的方法可能是使用一个计数器来设置类型“深度”的上限。另一种方法是保留已访问过的类型的类型级列表，这似乎太麻烦了，不值得。
因此，这里有一个解决方案，它GHC.Generics与类型族约束一起使用来强制执行非递归（或者从技术上讲，限制类型的“深度”）。
也许您已经熟悉一般GHC.Generics方法，但为了完整起见，以下是我们如何组合解决方案而不用担心递归。我们从要定义的类型类开始：
class Small a where
universe :: [a]
然后，我们引入一个风格化的泛型类型类，其中泛型类型a被替换为一个类型f p，它将扮演我们想要泛型处理的类型的f类型级表示的角色，而是一个从未使用过的虚拟类型变量：Rep aap
import GHC.Generics
class GSmall f where
guniverse :: [f p]
类型类的实例GSmall是在GHC.Generics表示元信息、总和和乘积类型以及构造函数字段的类型上定义的。
对于元信息（例如，字段名称等），像这样想要忽略它的泛型类应该简单地通过适当地GSmall使用构造函数包装或解开来“获取正确的类型” 。M1在这里，我们添加M1到 Universe 列表的每个元素：
instance GSmall f => GSmall (M1 i c f) where
guniverse = map M1 guniverse
对于和和乘积类型，我们需要分别由泛型类型和表示的空和 ( Void) 和空乘积 ( ) 的实例：()V1U1
-- handle uninhabited type Void
instance GSmall V1 where
guniverse = []
-- handle unit
instance GSmall U1 where
guniverse = [U1]
对于二进制和，类型级别表示使用运算符:+:，而通用居民分别由L1和R1构造函数表示。在这里，通过使用正确的构造函数包装，我们对guniverse和的左侧和右侧类型进行多态调用：
{-# LANGUAGE TypeOperators #-}
instance (GSmall f, GSmall g) => GSmall (f :+: g) where
guniverse = map L1 guniverse ++ map R1 guniverse
对于二元乘积，过程类似，只是我们要生成乘积左侧和右侧的所有组合：
instance (GSmall f, GSmall g) => GSmall (f :*: g) where
guniverse = [f :*: g | f <- guniverse, g <- guniverse]
最后，我们a通过循环回具体类来处理类型的构造函数字段Small：
instance Small a => GSmall (K1 r a) where
guniverse = map K1 universe
universe如果需要，我们可以在类中添加默认定义Small：
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
class Small a where
universe :: [a]
default universe :: (Generic a, GSmall (Rep a)) => [a]
universe = universeGeneric
universeGeneric :: (Generic a, GSmall (Rep a)) => [a]
universeGeneric = map to guniverse
要使用这个通用实例，我们编写
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
data Route = Index | Blog BlogR deriving (Show, Generic)
data BlogR = Foo | Bar deriving (Show, Generic)
instance Small Route
instance Small BlogR
main = print $ universe @Route
如果您想对某些类型使用非泛型实例，您也可以通过覆盖默认universe实例来实现：
universeEnum :: (Bounded a, Enum a) => [a]
universeEnum = [minBound..maxBound]
data BlogR = Foo | Bar deriving (Show, Enum, Bounded)
instance Small BlogR where universe = universeEnum
这是迄今为止的完整解决方案：
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
import GHC.Generics
class Small a where
universe :: [a]
default universe :: (Generic a, GSmall (Rep a)) => [a]
universe = universeGeneric
class GSmall f where
guniverse :: [f p]
universeGeneric :: (Generic a, GSmall (Rep a)) => [a]
universeGeneric = map to guniverse
universeEnum :: (Bounded a, Enum a) => [a]
universeEnum = [minBound..maxBound]
instance GSmall f => GSmall (M1 i c f) where
guniverse = map M1 guniverse
instance GSmall V1 where
guniverse = []
instance GSmall U1 where
guniverse = [U1]
instance (GSmall f, GSmall g) => GSmall (f :+: g) where
guniverse = map L1 guniverse ++ map R1 guniverse
instance (GSmall f, GSmall g) => GSmall (f :*: g) where
guniverse = [f :*: g | f <- guniverse, g <- guniverse]
instance Small a => GSmall (K1 r a) where
guniverse = map K1 universe
data Route = Index | Blog BlogR deriving (Show, Generic)
data BlogR = Foo | Bar deriving (Show, Generic)
instance Small Route
-- use generic
instance Small BlogR
-- or enum-based
-- instance Small BlogR where universe = universeEnum
main = print $ universe @Route
如果您尝试为非递归、非小型类型生成实例（Int例如，使用 ）：
data Route = Index | Blog BlogR deriving (Show, Generic)
data BlogR = PostId Int deriving (Show, Generic)
instance Small Route
instance Small BlogR -- error
你会得到一个错误：
No instance for (Small Int)
这看起来足够用户友好，没有TypeError.
一个问题是递归类型被接受，包括列表，所以我们可以定义：
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
data Route = Index | Blog BlogR deriving (Show, Generic)
data BlogR = PostId String deriving (Show, Generic)
instance Small Route
instance Small BlogR
instance Small String
instance Small Char where universe = universeEnum
并获取有效实例。对于您的显式递归示例也是如此。
我认为解决这个问题的最简单方法是定义一个单独的泛型类型族约束来检查类型是否是非递归的（或更准确地说，具有有限的深度）。这应该包括基于泛型的封闭类型系列，如下所示。请注意，此处使用该top参数来记住错误消息的顶级类型。正在处理的泛型类型是，并且如果 的深度不超过 中的深度“倒计时” ，f则族会产生一个空约束，否则：fnTypeError
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Kind
import GHC.TypeLits
type family GClosed n top f :: Constraint where
GClosed 0 top f = TypeError (Text "Depth limit exceeded by type: " :<>: ShowType top)
GClosed n top (M1 i c f) = GClosed n top f
GClosed n top V1 = ()
GClosed n top U1 = ()
GClosed n top (f :+: g) = (GClosed n top f, GClosed n top g)
GClosed n top (f :*: g) = (GClosed n top f, GClosed n top g)
GClosed n top (K1 r a) = NClosed (n-1) top a
请注意，调用类K1中关联类型系列的最终情况，默认为通过以下方式“关闭”的通用评估：NClosedSmallGClosed
class Small a where
...
type NClosed (n :: Nat) top a :: Constraint
type instance NClosed n top a = GClosed n top (Rep a)
然后我们可以定义：
type ClosedLimit = 20
type Closed a = NClosed ClosedLimit a a
并将此约束潜入 的定义中universeGeneric：
universeGeneric :: (Generic a, GSmall (Rep a), Closed a) => [a]
universeGeneric = map to guniverse
universe（以及对默认签名的相关更新class Small）。
GClosed和之间的这种分离NClosed使我们能够指示非泛型Small实例是用一些样板文件关闭的。例如，如果我们想让Word8s 很小：
instance Small Word8 where
universe = universeEnum -- use enum implementation
type NClosed n a Int = () -- Word8s are closed
完整的代码如下所示：
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
import GHC.Generics
import Data.Kind
import GHC.TypeLits
type Closed a = NClosed ClosedLimit a a
type family GClosed n top f :: Constraint where
GClosed 0 top f = TypeError (Text "Depth limit exceeded by type: " :<>: ShowType top)
GClosed n top (M1 i c f) = GClosed n top f
GClosed n top V1 = ()
GClosed n top U1 = ()
GClosed n top (f :+: g) = (GClosed n top f, GClosed n top g)
GClosed n top (f :*: g) = (GClosed n top f, GClosed n top g)
GClosed n top (K1 r a) = NClosed (n-1) top a
type ClosedLimit = 20
class Small a where
universe :: [a]
default universe :: (Generic a, GSmall (Rep a), Closed a) => [a]
universe = universeGeneric
type NClosed (n :: Nat) top a :: Constraint
type instance NClosed n top a = GClosed n top (Rep a)
class GSmall f where
guniverse :: [f p]
universeGeneric :: (Generic a, GSmall (Rep a), Closed a) => [a]
universeGeneric = map to guniverse
universeEnum :: (Bounded a, Enum a) => [a]
universeEnum = [minBound..maxBound]
instance GSmall f => GSmall (M1 i c f) where
guniverse = map M1 guniverse
instance GSmall V1 where
guniverse = []
instance GSmall U1 where
guniverse = [U1]
instance (GSmall f, GSmall g) => GSmall (f :+: g) where
guniverse = map L1 guniverse ++ map R1 guniverse
instance (GSmall f, GSmall g) => GSmall (f :*: g) where
guniverse = [f :*: g | f <- guniverse, g <- guniverse]
instance Small a => GSmall (K1 r a) where
guniverse = map K1 universe
data Route = Index | Blog BlogR deriving (Show, Generic)
data BlogR = Foo | Bar deriving (Show, Generic)
instance Small Route
instance Small BlogR
main = print $ universe @Route
你的两个“坏”例子都被拒绝了。首先：
data Route = Index | Blog BlogR deriving (Show, Generic)
data BlogR = Post String deriving (Show, Generic)
生成一些令人讨厌的错误消息NClosed以及相当友好的消息：
No instance for (Small [Char])
尝试定义instance Small [Char]将导致：
Depth limit exceeded by type: [Char]
而第二个：
data Route = Index | Blog BlogR deriving (Show, Generic)
data BlogR = Foo | Bar | Rec Route deriving (Show, Generic)
生成消息：
Depth limit exceeded by type: Route