http://osa1.net/posts/2014-03-07-parsec-left-recursion.html

gistfile1.hs

{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Main where


import           Control.Applicative ((<*))
import qualified Data.Set            as S
import           Prelude             hiding (exp)
import           Text.Parsec

import Debug.Trace


type MarksSeen = S.Set Int

type RecParser s m a = ParsecT s MarksSeen m a

putMark i = do
    is <- getState
    if S.member i is
      then fail "recursion"
      else putState $ S.insert i is

resetMarks = putState S.empty

plus = char '+' >> spaces
int  = fmap (Int . read) $ many1 digit <* spaces


data Exp = Add Exp Exp
         | App Exp Exp
         | Int Int
         deriving (Show)

add = do
    putMark 1
    e1 <- exp
    resetMarks
    plus
    e2 <- exp
    return $ Add e1 e2

app = do
    putMark 2
    fn <- exp
    resetMarks

    putMark 2
    as <- many1 exp
    resetMarks

    return $ foldl App fn as


exp = choice [try add, try app, int] <* spaces

pgm = exp <* eof

rec = putMark 0 >> rec >> resetMarks