使用ViewPatterns和PatternSynonyms来简单地模式匹配
假设我有一个像这样的语言的GADT（我的实际语言要复杂得多，大约有50个构造函数，但这是一个简化的例子）：
data Expr t where
Add :: Expr t -> Expr t -> Expr t
Sub :: Expr t -> Expr t -> Expr t
Mult :: Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t
现在让我们定义另一个数据类型，如下所示：
data BinOpT = AddOp | SubOp | MultOp
另外，可以说我有以下功能：
stringBinOp :: BinOpT -> String
stringBinOp AddOp = "+"
stringBinOp SubOp = "-"
stringBinOp MultOp = "*"
另外，让我们定义下面的类型：
data BinOp t = BinOp BinOpT (Expr t) (Expr t)
现在我想定义一个漂亮的打印功能，如下所示：
prettyPrint :: Show t => Expr t -> String
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
prettyPrint (Negate x) = "-" ++ prettyPrint x
prettyPrint (Abs x) = "abs(" ++ prettyPrint x ++ ")"
prettyPrint (Scalar x) = show x
请注意，这是无效的，因为BinOp不是Expr t的构造函数。
当然，我可以这样重新定义Expr t ：
data Expr t where
BinOp :: BinOp -> Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t
这样可以正常工作，但我宁愿不这样做。 它使得其他代码使用这个有点丑陋，而且我认为它在空间和时间方面效率会稍低一些，而且你必须匹配两个构造函数而不是一个，这意味着两个case语句（因此跳转表）而不是一个。
我怀疑我可以使用以下两个GHC扩展的组合来实现我试图干净地完成的任务，即：
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
但我不完全确定如何最好地做到这一点。 这个代码的一个简单例子会很有帮助（然后我可以将它应用到我正在处理的更复杂的语言中）。
如果解决方案编译时没有关于缺少模式匹配的警告，则可以获得许多假想奖励积分。 我知道GHC 8.2在这方面可能会有所帮助，所以GHC 8.2的例子对它进行详尽性检查的扩展将会很好，尽管GHC 8.2之前的解决方案通过详尽性检查会更好。
澄清：
我实际问的是我该如何做这样的事情：
prettyPrint :: Show t => Expr t -> String
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
prettyPrint (Negate x) = "-" ++ prettyPrint x
prettyPrint (Abs x) = "abs(" ++ prettyPrint x ++ ")"
prettyPrint (Scalar x) = show x
在保持Expr t的定义如下的同时：
data Expr t where
Add :: Expr t -> Expr t -> Expr t
Sub :: Expr t -> Expr t -> Expr t
Mult :: Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t
重要的是：
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
不能编译为BinOp不是Expr t的构造函数。 我想要这样编译的行，因为我不想在任何地方都这样做：
prettyPrint (Add x y) = ...
prettyPrint (Sub x y) = ...
prettyPrint (Mult x y) = ...
因为这意味着很多代码重复，因为许多函数都会使用Expr t 。
查看模式
asBinOp (Add a b) = Just (AddOp, a, b)
asBinOp (Sub a b) = Just (SubOp, a, b)
asBinOp (Mul a b) = Just (MulOp, a, b)
asBinOp _ = Nothing
prettyPrint (asBinOp -> Just (op, x, y)) = prettyPrint x ++ showOp op ++ prettyPrint y
... +模式同义词
pattern BinOp :: BinOpT -> Expr t -> Expr t -> Expr t
pattern BinOp op a b <- (asBinOp -> Just (op, a, b)) where
BinOp AddOp a b = Add a b
BinOp SubOp a b = Sub a b
BinOp MulOp a b = Mul a b
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
在GHC 8.2中，您可以使用此附注来满足穷举检查器：
{-# COMPLETE BinOp, Negate, Abs, Scalar #-}
上一篇: Using ViewPatterns and PatternSynonyms to simply pattern matches