Предложения автозаполнения от ошибки разбора

Question

Я пишу парсер для собственного ядра Jupter, используя мегапарсек. Мне удалось повторно использовать синтаксический анализатор для предоставления дополнений: пользовательское сообщение об ошибке, сгенерированное из библиотеки мегапарсек, преобразуется в список ожидаемых символов. Таким образом, всякий раз, когда я меняю парсер, завершение автоматически подстраивается. Что здорово.

Единственное, с чем я борюсь, это как получить информацию от необязательных парсеров. Минимальный пример, иллюстрирующий то, чего я хочу достичь, следующий:

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import Data.Monoid
import Data.Text (Text)
import Data.Set (singleton)

type Parser = Parsec MyError Text

data MyError = ExpectKeyword Text deriving (Eq, Ord, Show)

lexeme = L.lexeme sc
sc = L.space (skipSome (oneOf [' ', '\t'])) empty empty

-- | Reserved words
rword :: Text -> Parser Text
rword w = region (fancyExpect (ExpectKeyword w)) $
          lexeme (string w *> return w)

fancyExpect f e = FancyError (errorPos e) (singleton . ErrorCustom $ f)

p1 = rword "foo" <|> rword "bar"

p2 = (<>) <$> option "def" (rword "opt") <*> p1

main = do
  putStrLn . show $ parse p1 "" ("xyz" :: Text) -- shows "foo" and "bar" in errors
  putStrLn . show $ parse p2 "" ("xyz" :: Text) -- like above, no optional "opt"

В первом случае парсер не работает, и я получаю список всех ошибок из всех альтернатив. В идеале, во втором случае я хотел бы видеть ошибку неудачного необязательного парсера.

Этот пример может быть просто решен путем удаления option и сделать две ветви с <|>: один с опцией, а другой без. Однако в реальном случае необязательная часть представляет собой синтаксический анализатор перестановок, состоящий из нескольких необязательных частей, поэтому такой прием неосуществим.