2010.hs

import Data.List

data RationalNum = RationalNum Int Int

data Expr = NumExpr Int
          | OpExpr String Expr Expr

instance Show Expr where
    show (NumExpr a) = show a
    show (OpExpr op a b) = "("++op++" "++show a++" "++show b++")"

eval :: Expr -> Maybe RationalNum
eval (NumExpr a) = Just $ RationalNum a 1
eval (OpExpr op a b) = eval a >>=
    \(RationalNum an ad) -> eval b >>=
        \(RationalNum bn bd) -> lookup op [("+",ratioAdd),("-",ratioSub),("*",ratioMul),("/",ratioDiv)] >>=
            \opfunc -> opfunc an ad bn bd
    where
        ratioAdd an ad bn bd = Just $ RationalNum (an*bd+bn*ad) (ad*bd)
        ratioSub an ad bn bd = Just $ RationalNum (an*bd-bn*ad) (ad*bd)
        ratioMul an ad bn bd = Just $ RationalNum (an*bn) (ad*bd)
        ratioDiv an ad bn bd = if 0 == ad*bn then Nothing else Just $ RationalNum (an*bd) (ad*bn)

compareIR :: Int -> Maybe RationalNum -> Bool
compareIR a Nothing = False
compareIR a (Just (RationalNum b c)) = b == a*c

genExpr :: [Int] -> [Expr]
genExpr [] = []
genExpr [x] = [NumExpr x]
genExpr xs = concat $ concatMap (\(as,bs) -> [phi a b|a <- genExpr as,b <- genExpr bs]) $
    takeWhile ((xs/=).fst) $ map (\n -> (take n xs,drop n xs)) [1..]
    where phi a b@(OpExpr "+" _ _) =  map (\op -> OpExpr op a b) ["*","/"]
          phi a b@(OpExpr "-" _ _) =  map (\op -> OpExpr op a b) ["*","/"]
          phi a b@(OpExpr "*" _ _) =  map (\op -> OpExpr op a b) ["+","-"]
          phi a b@(OpExpr "/" _ _) =  map (\op -> OpExpr op a b) ["+","-"]
          phi a b = map (\op -> OpExpr op a b) ["+","-","*","/"]

genTrueExpr :: Int -> [Int] -> [Expr]
genTrueExpr n xs = filter (compareIR n.eval) $ genExpr xs

main :: IO ()
main = print $ genTrueExpr 2010 [1..9]