How do I create a recursive infix parser that does not hang? - haskell

Question

Consider this code:
import Text.ParserCombinators.ReadP
prefixExpr :: ReadP Int
prefixExpr = choice [readPlus, readS_to_P reads]
where
readPlus = do
string "+ "
s1 <- prefixExpr
string " "
s2 <- prefixExpr
return $ s1 + s2
p $. s = case [ x | (x,"") <- p `readP_to_S` s ] of
[x] -> Right x
[ ] -> Left "mkRead: no parse"
_ -> Left "mkRead: ambiguous parse"
It works great!
λ prefixExpr $. "+ 1 + 2 3"
Right 6
But this variant does not:
infixExpr :: ReadP Int
infixExpr = choice [readPlus, readS_to_P reads]
where
readPlus = do
s1 <- infixExpr
string " + "
s2 <- infixExpr
return $ s1 + s2
Actually, it hangs.
λ infixExpr $. "1 + 2 + 3"
^CInterrupted.
λ infixExpr $. "1"
^CInterrupted.
I understand that infixExpr enters infinite recursion trying to decide whether "1" is a number
or the start of an expression, but I wonder how I can prevent that. I do not really need my
program to explore all the possibilities indefinitely, just to pick the most obvious one and disregard
the others altogether. How can I do that?
One thing I tried is to put a restriction on the recursive depth.
infixExpr :: Int -> ReadP Int
infixExpr 0 = number
infixExpr n = choice [plus, number]
where
plus = do
s1 <- infixExpr (n - 1)
string " + "
s2 <- infixExpr (n - 1)
return $ s1 + s2
It kind of works, but it is practically useless because of its exponential complexity.

Answer 1

As suggested by #chi, removing left recursion through factorization:
infixExpr :: ReadP Int
infixExpr = number >>= \x -> choice [plus x, eof >> return x]
where
plus x = do
string " + "
y <- infixExpr
return $ x + y
It works:
λ infixExpr $. "1"
Right 1
λ infixExpr $. "1 + 2"
Right 3
λ infixExpr $. "1 + 2 + 3"
But I am a bit unhappy about it. I would rather that the original grammar was made to work, because it looks more like human thinking than this one.
To be fair, the same effect could be achieved easier, by a very small edit:
infixExpr :: ReadP Int
infixExpr = choice [plus, number]
where
plus = do
s1 <- number -- Notice!
string " + "
s2 <- infixExpr
return $ s1 + s2
I figured it some time ago, but I really wanted to have this symmetry to the definition of plus.