使用 Uniplate 简化 GADT

Question

我正在尝试回答this stackoverflow question, using uniplate as I suggested，但the only solution I've come up with so far 很丑。

这似乎是一个相当普遍的问题，所以我想知道是否有更优雅的解决方案。

基本上，我们有一个 GADT，它可以解析为 Expression Int 或 Expression Bool（忽略 codataIf = If (B True) codataIf codataIf）：

data Expression a where
    I :: Int -> Expression Int
    B :: Bool -> Expression Bool
    Add :: Expression Int  -> Expression Int  -> Expression Int
    Mul :: Expression Int  -> Expression Int  -> Expression Int
    Eq  :: Expression Int  -> Expression Int  -> Expression Bool
    And :: Expression Bool -> Expression Bool -> Expression Bool
    Or  :: Expression Bool -> Expression Bool -> Expression Bool
    If  :: Expression Bool -> Expression a    -> Expression a -> Expression a

并且（在我的问题版本中）我们希望能够使用一个简单的操作从下到上评估表达式树，将叶子组合成一个新的叶子：

step :: Expression a -> Expression a
step = \case
  Add (I x) (I y)   -> I $ x + y
  Mul (I x) (I y)   -> I $ x * y
  Eq (I x) (I y)    -> B $ x == y
  And (B x) (B y)   -> B $ x && y
  Or (B x) (B y)    -> B $ x || y
  If (B b) x y      -> if b then x else y
  z                 -> z

我在使用DataDeriving 派生Uniplate 和Biplate 实例时遇到了一些困难（这可能应该是一个危险信号），所以 我为Expression Int、Expression Bool 和Biplate 实例滚动了我自己的Uniplate 实例(Expression a) (Expression a)、(Expression Int) (Expression Bool) 和(Expression Bool) (Expression Int)。

这让我想出了这些自下而上的遍历：

evalInt :: Expression Int -> Expression Int
evalInt = transform step

evalIntBi :: Expression Bool -> Expression Bool
evalIntBi = transformBi (step :: Expression Int -> Expression Int)

evalBool :: Expression Bool -> Expression Bool
evalBool = transform step

evalBoolBi :: Expression Int -> Expression Int
evalBoolBi = transformBi (step :: Expression Bool -> Expression Bool)

但由于它们中的每一个都只能进行一次转换（结合Int 叶子或Bool 叶子，但两者都不能），它们无法完成完整的简化，而必须手动链接在一起：

λ example1
If (Eq (I 0) (Add (I 0) (I 0))) (I 1) (I 2)
λ evalInt it
If (Eq (I 0) (I 0)) (I 1) (I 2)
λ evalBoolBi it
If (B True) (I 1) (I 2)
λ evalInt it
I 1
λ example2
If (Eq (I 0) (Add (I 0) (I 0))) (B True) (B False)
λ evalIntBi it
If (Eq (I 0) (I 0)) (B True) (B False)
λ evalBool it
B True

我的 hackish 解决方法是为 Either (Expression Int) (Expression Bool) 定义一个 Uniplate 实例：

type  WExp = Either (Expression Int) (Expression Bool)

instance Uniplate WExp where
  uniplate = \case
      Left (Add x y)    -> plate (i2 Left Add)  |* Left x  |* Left y
      Left (Mul x y)    -> plate (i2 Left Mul)  |* Left x  |* Left y
      Left (If b x y)   -> plate (bi2 Left If)  |* Right b |* Left x  |* Left y
      Right (Eq x y)    -> plate (i2 Right Eq)  |* Left x  |* Left y
      Right (And x y)   -> plate (b2 Right And) |* Right x |* Right y
      Right (Or x y)    -> plate (b2 Right Or)  |* Right x |* Right y
      Right (If b x y)  -> plate (b3 Right If)  |* Right b |* Right x |* Right y
      e                 -> plate e
    where i2 side op (Left x) (Left y) = side (op x y)
          i2 _ _ _ _ = error "type mismatch"
          b2 side op (Right x) (Right y) = side (op x y)
          b2 _ _ _ _ = error "type mismatch"
          bi2 side op (Right x) (Left y) (Left z) = side (op x y z)
          bi2 _ _ _ _ _ = error "type mismatch"
          b3 side op (Right x) (Right y) (Right z) = side (op x y z)
          b3 _ _ _ _ _ = error "type mismatch"

evalWExp :: WExp -> WExp
evalWExp = transform (either (Left . step) (Right . step))

现在我可以做完整的简化了：

λ evalWExp . Left $ example1
Left (I 1)
λ evalWExp . Right $ example2
Right (B True)

但是为了完成这项工作，我必须做大量的error 和包装/解包，这让我觉得这不雅和错误。

有没有正确的方法来解决这个问题uniplate？

Answer 1

没有正确的方法可以用单板解决这个问题，但是有一个正确的方法可以用相同的机制解决这个问题。 uniplate 库不支持将类型为 * -> * 的数据类型单向化，但我们可以创建另一个类来适应这种情况。这是用于* -> * 类型的最小单板库。它基于当前 git 版本的 Uniplate 已更改为使用 Applicative 而不是 Str。

{-# LANGUAGE RankNTypes #-}

import Control.Applicative
import Control.Monad.Identity

class Uniplate1 f where
    uniplate1 :: Applicative m => f a -> (forall b. f b -> m (f b)) -> m (f a)

    descend1 :: (forall b. f b -> f b) -> f a -> f a
    descend1 f x = runIdentity $ descendM1 (pure . f) x

    descendM1 :: Applicative m => (forall b. f b -> m (f b)) -> f a -> m (f a)
    descendM1 = flip uniplate1

transform1 :: Uniplate1 f => (forall b. f b -> f b) -> f a -> f a
transform1 f = f . descend1 (transform1 f)

现在我们可以为Expression 编写一个Uniplate1 实例：

instance Uniplate1 Expression where
    uniplate1 e p = case e of
        Add x y -> liftA2 Add (p x) (p y)
        Mul x y -> liftA2 Mul (p x) (p y)
        Eq  x y -> liftA2 Eq  (p x) (p y)
        And x y -> liftA2 And (p x) (p y)
        Or  x y -> liftA2 Or  (p x) (p y)
        If  b x y -> pure If <*> p b <*> p x <*> p y
        e -> pure e

此实例与我在my answer to the original question 中编写的emap 函数非常相似，不同之处在于此实例将每个项目放入Applicative Functor。 descend1 只是将其参数提升为 Identity 和 runIdentity 的结果，使 desend1 与 emap 相同。因此transform1 与上一个答案中的postmap 相同。

现在，我们可以根据transform1 来定义reduce。

reduce = transform1 step

这足以运行一个示例：

"reduce"
If (And (B True) (Or (B False) (B True))) (Add (I 1) (Mul (I 2) (I 3))) (I 0)
I 7