Незапланированное жадное поведение в uu-parsinglib

Проблема

Сегодня столкнулся с проблемой и не знаю как решить. Это очень странно для меня, потому что код, который я написал, должен (согласно моим текущим знаниям) быть правильным.

Итак, ниже вы можете найти примеры комбинаторов парсера. Наиболее важным из них является pOperator, который очень простым способом (только для демонстрационных целей) строит оператор AST. Он использует «x» и может использовать несколько «x», разделенных пробелами.

У меня также есть комбинатор pParens, который определяется как:

pPacked pParenL (pWSpaces *> pParenR)

поэтому он использует пробелы перед закрытием скобки.

Пример ввода/вывода

Правильный ввод/вывод ДОЛЖЕН быть:

in: "(x)"
out: Single "x"

in: "(x )"
out: Single "x"

но я получаю:

in: "(x)"
out: Single "x"

in: "(x )" 
out: Multi (Single "x") (Single "x")
--  Correcting steps: 
--    Inserted  'x' at position LineColPos 0 3 3 expecting one of ['\t', ' ', 'x']

но во втором примере я получаю ошибку - и парсер ведет себя так, как будто он жадно ест какие-то токены (и жадной операции нет).

Я был бы благодарен за любую помощь в этом.

Пример кода

import Prelude hiding(lex)
import Data.Char hiding (Space)
import qualified Text.ParserCombinators.UU as UU
import           Text.ParserCombinators.UU hiding(parse)
import qualified Text.ParserCombinators.UU.Utils as Utils
import           Text.ParserCombinators.UU.BasicInstances hiding (Parser)


data El = Multi El El
        | Single String
        deriving (Show)


---------- Example core grammar ----------

pElement     = Single <$> pSyms "x"
pOperator    = applyAll <$> pElement <*> pMany (flip <$> (Multi <$ pWSpaces1) <*> pElement)

---------- Basic combinators ----------

applyAll x (f:fs) = applyAll (f x) fs
applyAll x []     = x

pSpace    = pSym ' '
pTab      = pSym '\t'
pWSpace   = pSpace <|> pTab
pWSpaces  = pMany pWSpace
pWSpaces1 = pMany1 pWSpace
pMany1 p  = (:) <$> p <*> pMany p

pSyms []       = pReturn []
pSyms (x : xs) = (:) <$> pSym x <*> pSyms xs

pParenL     = Utils.lexeme $ pSym '('
pParenR     = Utils.lexeme $ pSym ')'
pParens     = pPacked pParenL (pWSpaces *> pParenR)

---------- Program ----------

pProgram = pParens pOperator
-- if you replace it with following line, it works:
--  pProgram = pParens pElement
-- so it seems like something in pOperator is greedy

tests = [ ("test", "(x)")
        , ("test", "(x )")
        ]

---------- Helpers ----------

type Parser a = P (Str Char String LineColPos) a

parse p s = UU.parse ( (,) <$> p <*> pEnd) (createStr (LineColPos 0 0 0) s)

main :: IO ()
main = do 
    mapM_ (\(desc, p) -> putStrLn ("\n=== " ++ desc ++ " ===") >> run pProgram p) tests
    return ()

run :: Show t =>  Parser t -> String -> IO ()
run p inp = do  let (a, errors) =  parse p inp
                putStrLn ("--  Result: \n" ++ show a)
                if null errors then  return ()
                               else  do putStr ("--  Correcting steps: \n")
                                        show_errors errors
                putStrLn "-- "
             where show_errors :: (Show a) => [a] -> IO ()
                   show_errors = sequence_ . (map (putStrLn . show))

ВАЖНО

pOperator    = applyAll <$> pElement <*> pMany (flip <$> (Multi <$ pWSpaces1) <*> pElement)

эквивалентно:

foldr pChainl pElement (Multi <$ pWSpaces1)

согласно: Разбор комбинатора: краткий Учебник

И он используется для определения приоритета оператора.