Reduce boilerplate around a hand-wrapped `Num` type-CodePudding

(With possibly using GHC extensions), is there a way to reduce boilerplate in this kind of code?

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

Deriving instance Num Number would run into the same issue.

CodePudding user response：

In this example you can just reorder the structure:

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 -> (*)

CodePudding user response：

If you just want to reduce the boilerplate of the similar pattern matches, then the standard strategy works. Make a helper function that does the repeating stuff, and pull out the bits that vary into parameters:

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 (/)

I added deriving Show just so you can see it works in 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

If you want, you can then apply the same strategy again to get rid of the repeated calls to liftIntFloatBinOp (although with a less verbose name they would matter less anyway), by implementing something like:

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

You may have been hoping for something fancy like using {-# LANGUAGE RankNTypes #-} to write:

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

This does work to a degree. You can use this to try:

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

But it fails when you want division:

λ 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)

It fails for the a very simple reason you would have noticed yourself if you'd actually kept going with your original boilerplatey version: there is no single division operator that works on both integers and floating point numbers. So there's no polymorphic function you can pass that can be applied to either type your Number might contain, even when you use RankNTypes to pass an argument function that is "still polymorphic".

So honestly, the low-tech helper function approach is probably better.

CodePudding user response：

You can make a generic function first:

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

then it is:

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