Find expressions that match target value

expressions_equal_target.hs

{-
The origin of this puzzle if from #codingame chat. Ideas for the high
level approach come from TheNinja.

Write a program that outputs all possibilities to put + or - or nothing
between the numbers 1,2,...,9 (in this order) such that the result is
equal to stdin. For an example: 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100.

Usage:

First line of input is the digits to use in order.
Each additional line is a target number for generating expressions.

Input:

123456789
100

Output:

1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9
12+3+4+5-6-7+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
123+4-5+67-89
123+45-67+8-9
123-4-5-6-7+8-9
123-45-67+89
-}
import Data.Char (digitToInt)

main :: IO ()
main = do
    digits <- getLine
    s <- getContents
    let expressions = genExpressions digits
    putStr $ (concatMap (unlines . matchTarget expressions . read) . lines) s

-- |Filters a list of expressions to those that match the target value.
matchTarget :: [String] -> Int -> [String]
matchTarget expressions target = filter ((== target) . parse) expressions

-- |Generates all of the expressions from the digits using addition and
-- subtraction.
genExpressions :: String -> [String]
genExpressions [a, b] = partialExpression [a] [b]
genExpressions digits =
    concatMap (\x -> partialExpression x [last digits]) $
        genExpressions (init digits)

-- |Combines two strings using addition, subtraction, or concatenation.
-- For example: `partialExpression "1" "2"` returns the list
-- `["1+2","1-2","12"]`. Call this recursively on the output to create
-- all permutations e.g., `partialExpression "1+2" "3"`.
partialExpression :: String -> String -> [String]
partialExpression left right =
    [left ++ operator ++ right | operator <- ["+","-",""]]

-- |Evaluates an expression. For example `parse "12-3+4"` returns `13`.
parse :: String -> Int
parse = parse' 0 1 0

-- |Evaluates an expression one character at a time.
parse' :: Int -> Int -> Int -> String -> Int
parse' left op right [] = left + (op * right)
parse' left op right ('+':xs) = parse' (left + (op * right)) 1 0 xs
parse' left op right ('-':xs) = parse' (left + (op * right)) (-1) 0 xs
parse' left op right (x:xs) = parse' left op (right * 10 + digitToInt x) xs