Question

让我们看看以下代码：

transformBi (++"asdasd") [1,2,3,4]

显然，这段代码什么都不做，但它仍然编译得很好。我想创建一个新版本的transformBi，如果编译器可以通过类型证明它是无操作，则不会编译。理想情况下，这可以通过名为Contains的类型类来完成，因此新transformBi的类型将是

transformBi :: (Biplate from to, Contains from to) => (to -> to) -> from -> from

我们如何实施Contains？

我正在寻找一个可以自动派生的Contains，而不是我必须为每个代数数据类型编写的东西。

Answer 1

如果某个类型有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 - 可能会访问某些字段，也可能不访问某些字段，因此我们无法再解释什么是“无操作”以及“＆＃” 39;不是，这是为什么它不能在那里工作的另一个原因。
我们依赖GHC和uniplate内部的一致性，i。即我们假设uniplate访问to字段，如果Rep包含相应的字段。这是一个合理的假设，但可能会被我们无法控制的错误打破。此外，每当Contains表示API更改时，我们都必须更改Generic的定义。另一方面，我们不会为Generic支付任何运行时惩罚，因为我们只在编译时检查Rep。

Answer 2

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，所以这不会真正起作用。

确保haskell类型A包含类型B的成员

2 个答案: