[Haskell-beginners] How to remove some duplication from this code?

[Mike Meyer]

On Tue, 13 Dec 2011 21:40:13 +0000
Peter Hall <peter.hall at memorphic.com> wrote:

> It seems to work, but I could do with some feedback, as it isn't quite
> satisfactory. It feels like I should be able to remove some of the
> duplicated code in the eval function, and also in evalIntExpr and
> evalBoolExpr, which are identical except for having Left and Right
> reversed.

I'm also relatively new at this. My first thought was "eval should be
pure". After going back and reading the description, and thinking
about why you were running in the Maybe monad, I figured out what was
going on.

Anyway, here's my take on it. I've left your code quoted, added the
new code in unquoted, and deleted what it replaced.

    <mike


> -------- Arithmetic.hs
> 
> module Arithmetic where
> import Data.Maybe
> 
> data Expr = I Int
>     | B Bool
>     | Add Expr Expr
>     | Mult Expr Expr
>     | Eq Expr Expr
> 
> eval :: Expr -> Maybe (Either Bool Int)
> eval (B b) = return $ Left b
> eval (I i) = return $ Right i

eval (Mult e1 e2) = applyIntOp Right (*) e1 e2
eval (Add e1 e2) = applyIntOp Right (+) e1 e2
eval (Eq e1 e2) = applyIntOp Left (==) e1 e2

applyIntOp :: (t -> b) -> (Int -> Int -> t) -> Expr -> Expr -> Maybe b
applyIntOp const func e1 e2 = do
    a1 <- evalIntExpr e1
    a2 <- evalIntExpr e2
    return $ const $ func a1 a2


> evalIntExpr :: Expr -> Maybe Int
evalIntExpr e = eval e >>= (either (\_ -> Nothing) Just)

> evalBoolExpr :: Expr -> Maybe Bool
evalBoolExpr e = eval e >>= (either Just (\_ -> Nothing))

> 
> ------- Main.hs
> 
> module Main (
>     main
> ) where
> 
> import Arithmetic
> import Data.Maybe
> import Data.Either
> 
> test :: Expr
> test = Eq
>         (Mult
>             (Add
>                 (I 1)
>                 (I 2)
>             )
>             (I 5)
>         )
>         (I 15)
> 
> main :: IO ()
> main = do
>     putStrLn $ case eval test of
>         Nothing -> "Invalid expression"
>         Just (Left x) -> show x
>         Just (Right x) -> show x