让我们看看下面的代码：
transformBi (++"asdasd") [1,2,3,4]
显然，这段代码什么也没做，但它仍然可以正常编译。如果编译器可以通过类型证明它是无操作的，我想创建一个不会编译的新版本的 transformBi。理想情况下，这将由名为Contains 的类型类完成，因此新的transformBi 的类型将是
transformBi :: (Biplate from to, Contains from to) => (to -> to) -> from -> from
我们如何实现Contains？
我正在寻找可以自动派生的Contains，而不是我必须为每种代数数据类型编写的东西。
【问题讨论】：
标签： generics haskell typeclass strong-typing uniplate
如果有一个类型的Generic 实例，那么我们可以搜索其泛型表示的类型以查找某个字段。我们希望能够遍历递归和相互递归的类型，所以我们需要：
确保我们不会在递归类型上无休止地循环。我们需要记录访问过的类型，遇到一个就停下来。
使类型族调用足够懒惰，以便 GHC 在我们想要的时候真正停止计算。封闭类型族仅在自顶向下的方程匹配时是惰性的（即计算在第一个匹配方程处停止），因此我们使用帮助器进行递归。
这里是：
{-# LANGUAGE
TypeOperators,
TypeFamilies,
DataKinds,
ConstraintKinds,
UndecidableInstances,
DeriveGeneric,
DeriveDataTypeable
#-}
import Data.Generics.Uniplate.Data
import GHC.Generics
import Data.Type.Bool
import Data.Type.Equality
import Data.Data
type family Elem (x :: *) (xs :: [*]) :: Bool where
Elem x '[] = False
Elem x (y ': xs) = (x == y) || Elem x xs
type family LazyRec hasVisited vis t x where
LazyRec True vis x y = False
LazyRec False vis x x = True
LazyRec False vis t x = Contains (t ': vis) (Rep t ()) x
type family Contains (visited :: [*]) (t :: *) (x :: *) :: Bool where
Contains vis (K1 i c p) x = LazyRec (Elem c vis) vis c x
Contains vis ((:+:) f g p) x = Contains vis (f p) x || Contains vis (g p) x
Contains vis ((:*:) f g p) x = Contains vis (f p) x || Contains vis (g p) x
Contains vis ((:.:) f g p) x = Contains vis (f (g p)) x
Contains vis (M1 i t f p) x = Contains vis (f p) x
Contains vis t x = False
现在我们可以为 Biplate 定义一个简写，它仅在 from 可能包含 to 字段时才有效：
type family Biplate' from to where
Biplate' from to = (Contains '[from] (Rep from ()) to ~ True, Biplate from to)
你看：
transformBi' :: Biplate' from to => (to -> to) -> from -> from
transformBi'= transformBi
-- this one typechecks, but it's a no-op.
foo :: [Int]
foo = transformBi (++"foo") ([0..10] :: [Int])
-- type error
foo' :: [Int]
foo' = transformBi' (++"foo") ([0..10] :: [Int])
-- works as intended
foo'' :: [Int]
foo'' = transformBi' (+(10::Int)) ([0..10] :: [Int])
-- works for recursive/mutually recursive types too
data Foo = Foo Int Bar deriving (Show, Generic, Typeable, Data)
data Bar = Nil | Cons () Foo deriving (Show, Generic, Typeable, Data)
foo''' :: Bar
foo''' = transformBi' (+(10::Int)) (Cons () (Foo 0 Nil))
一些注意事项：
这仅适用于Data.Generic.Uniplate.Data。在Uniplate.Direct 的情况下，我们可以实现自定义的biplate-s，它可能会或可能不会访问某些字段，所以我们不能再推理什么是空操作，什么不是，这是另一个原因在那里工作。
我们依赖 GHC 和 uniplate 内部的一致性，即。 e.我们假设uniplate 访问了to 字段，而当Rep 包含相应的字段。这是一个合理的假设，但可能会被我们无法控制的错误破坏。此外，每当 Generic 表示 API 更改时，我们都必须更改 Contains 的定义。另一方面，我们不会为Generic 支付任何运行时惩罚，因为我们只在编译时检查Rep。
【讨论】：
Contains 可以是空类型类，因为它没有方法。您只提供您需要的实例。例如，在这种情况下，如果您只有
class Contains from to
instance Contains [a] a
您的示例代码将无法编译，因为没有与 instance Contains [Int] String 匹配的内容。
如果您打算广泛使用Contains，您可以将定义更改为class Biplate from to => Contains from to，然后您只需指定Contains 约束。
请注意，如果您有大量嵌套类型，则可能需要编写大量 Contains 实例。
我希望您可以简单地省略 Biplate 实例而不是添加这个额外的类，但是看起来有一个相当广泛的 instance (Data a, Data b, Uniplate b, Typeable a, Typeable b) => Biplate a b 所以这不会真正起作用。
【讨论】：