如果你只是想减少相似模式匹配的样本，那么标准策略就可以了，创建一个helper函数来做重复的事情，并把变化的比特提取到参数中：

data Operation = Add | Sub | Mult | Div
  deriving Show

data Number
  = IntVal Integer
  | FloatVal Double
  deriving Show

liftIntFloatBinOp
  :: (Integer -> Integer -> Integer) -> (Double -> Double -> Double)
  -> (Number -> Number -> Number)
liftIntFloatBinOp iOp fOp x y
  = case (x, y) of
      (IntVal x', IntVal y') -> IntVal $ x' `iOp` y'
      (FloatVal x', FloatVal y') -> FloatVal $ x' `fOp` y'
      _ -> undefined

evaluate :: Operation -> (Number -> Number -> Number)
evaluate op
 = case op of
     Add -> liftIntFloatBinOp (+) (+)
     Sub -> liftIntFloatBinOp (-) (-)
     Mult -> liftIntFloatBinOp (*) (*)
     Div -> liftIntFloatBinOp div (/)

我添加了deriving Show，这样您就可以看到它在ghci中工作：

λ let (|*|) = evaluate Mult in IntVal 3 |*| IntVal 7
IntVal 21
it :: Number

λ let (|*|) = evaluate Mult in FloatVal 3 |*| FloatVal 7
FloatVal 21.0
it :: Number

λ let (|*|) = evaluate Mult in FloatVal 3 |*| IntVal 7
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
  error, called at libraries/base/GHC/Err.hs:74:14 in base:GHC.Err
  undefined, called at foo.hs:19:12 in main:Number

如果需要，您可以再次应用相同的策略来消除对liftIntFloatBinOp的重复调用（尽管使用不那么冗长的名称，它们也不会那么重要），方法是实现如下内容：

toIntFloatOps :: Operation -> (Integer -> Integer -> Integer, Double -> Double -> Double)
toIntFloatOps op
  = case op of
      Add -> ((+), (+))
      Sub -> ((-), (-))
      Mult -> ((*), (*))
      Div -> (div, (/))

evaluate :: Operation -> (Number -> Number -> Number)
evaluate = uncurry liftIntFloatBinOp . toIntFloatOps

您可能希望使用一些花哨的语句，例如使用{-# LANGUAGE RankNTypes #-}来编写：

liftNumOp
  :: (forall t. Num t => t -> t -> t)
  -> (Number -> Number -> Number)
liftNumOp op x y
  = case (x, y) of
      (IntVal x', IntVal y') -> IntVal $ x' `op` y'
      (FloatVal x', FloatVal y') -> FloatVal $ x' `op` y'
      _ -> undefined

这在一定程度上是有效的。你可以用它来尝试：

λ liftNumOp (*) (IntVal 3) (IntVal 6)
IntVal 18

但是当你想除法的时候就失败了：

λ liftNumOp (/) (IntVal 3) (IntVal 6)

<interactive>:16:11: error:
    • Could not deduce (Fractional t) arising from a use of ‘/’
      from the context: Num t
        bound by a type expected by the context:
                   forall t. Num t => t -> t -> t
        at <interactive>:16:11-13
      Possible fix:
        add (Fractional t) to the context of
          a type expected by the context:
            forall t. Num t => t -> t -> t
    • In the first argument of ‘liftNumOp’, namely ‘(/)’
      In the expression: liftNumOp (/) (IntVal 3) (IntVal 6)
      In an equation for ‘it’: it = liftNumOp (/) (IntVal 3) (IntVal 6)

λ liftNumOp (div) (IntVal 3) (IntVal 6)

<interactive>:17:12: error:
    • Could not deduce (Integral t) arising from a use of ‘div’
      from the context: Num t
        bound by a type expected by the context:
                   forall t. Num t => t -> t -> t
        at <interactive>:17:11-15
      Possible fix:
        add (Integral t) to the context of
          a type expected by the context:
            forall t. Num t => t -> t -> t
    • In the first argument of ‘liftNumOp’, namely ‘(div)’
      In the expression: liftNumOp (div) (IntVal 3) (IntVal 6)
      In an equation for ‘it’: it = liftNumOp (div) (IntVal 3) (IntVal 6)

它失败的原因很简单，如果你继续使用你原来的样板版本，你自己也会注意到：没有一个除法运算符可以同时作用于整数和浮点数，所以没有一个多态函数可以传递给Number可能包含的任何一种类型，即使你使用RankNTypes来传递一个“仍然多态”的参数函数。
所以老实说，低技术含量的辅助函数方法可能更好。

在此示例中，您可以只对结构重新排序：

evaluate op lhs rhs = case (lhs, rhs) of
    (IntVal i, IntVal j) -> IntVal $ i % j
    (FloatVal x, FloatVal y) -> FloatVal $ x % y
    _ -> undefined
 where (%) :: Num a => a -> a -> a
       (%) = case op of
         Add -> (+)
         Sum -> (-)
         Mult -> (*)

您可以先创建泛型函数：

handling :: (Integer -> Integer -> Integer) -> (Float -> Float -> Float) -> Number -> Number -> Number
handling f g = go
  where go (IntVal x) (IntVal y) = IntVal (f x y)
        go (FloatVal x) (FloatVal y) = FloatVal (g x y)
        go _ _ = undefined

则为：

evaluate :: Operation -> Number -> Number -> Number
evaluate Add = handling (+) (+)
evaluate Sub = handling (-) (-)
evaluate Mult = handling (*) (*)

可以考虑的一个相当原始的替代选择：

evaluate op (IntVal l) (IntVal r) = IntVal $ case op of
    Add -> l + r
    Sub -> l - r
    Mult -> l * r

evaluate op (FloatVal l) (FloatVal r) = FloatVal $ case op of
    Add -> l + r
    Sub -> l - r
    Mult -> l * r

evaluate op _ _ = undefined

重复的次数没有减少到零，但减少了很多。