haskell - 减少围绕手工包装的 `Num` 类型的样板

Question

(可能使用 GHC 扩展)，有没有办法减少这种代码中的样板文件？

data Operation = Add | Sub | Mult | Div

data Number
    = IntVal Integer
    | FloatVal Double

evaluate :: Operation -> Number -> Number -> Number
evaluate op lhs rhs = case op of
  Add -> case (lhs, rhs) of
    (IntVal i, IntVal j) -> IntVal $ i + j
    (FloatVal x, FloatVal y) -> FloatVal $ x + y
    _ -> undefined

  Sub -> case (lhs, rhs) of
    (IntVal i, IntVal j) -> IntVal $ i - j
    (FloatVal x, FloatVal y) -> FloatVal $ x - y
    _ -> undefined

  Mult -> case (lhs, rhs) of
    (IntVal i, IntVal j) -> IntVal $ i * j
    (FloatVal x, FloatVal y) -> FloatVal $ x * y
    _ -> undefined

派生 instance Num Number 会遇到同样的问题。

Answer 1

如果您只想减少相似模式匹配的样板，那么标准策略就可以了。制作一个辅助函数来执行重复的操作，并提取参数中变化的位:

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)

它失败的原因很简单，如果您实际上继续使用原始样板版本，您会注意到自己:没有没有同时适用于整数和 float 的除法运算符数字。因此，即使您使用 RankNTypes 传递“仍然是多态”的参数函数，也没有您可以传递的多态函数可以应用于您的 Number 可能包含的任何一种类型.

老实说，低技术含量的辅助函数方法可能更好。