Как вернуть несколько сбоев разбора в монадическом контексте Parsec?

Question

У меня есть грамматика, которую я анализирую, которая состоит из ровно двух необходимых и уникальных логических частей, Alpha и Beta. Эти части могут быть определены в любом порядке, Alpha до Beta или visa-vera. Я хотел бы предоставить надежные сообщения об ошибках для менее опытных пользователей.

В приведенном ниже примере есть случаи, когда существует несколько сбоев разбора. Я объединяю сообщение об ошибке String с функцией unlines и передаю полученную конкатенацию в комбинатор fail. Это создает значение ParseError с одиночнымMessage значение, когда parse вызывается на grammarDefinition.

Пример сценария:

import Data.Either     (partitionEithers) 
import Data.Set      (Set) 
import Text.Parsec     (Parsec) 
import Text.Parsec.Char 
import Text.ParserCombinators.Parsec 

data Result = Result Alpha Beta 
type Alpha = Set (Int,Float) 
type Beta = Set String 

grammarDefinition :: Parsec String u Result 
grammarDefinition = do 
    segments <- partitionEithers <$> many segment 
    _  <- eof 
    case segments of 
     ( [],  []) -> fail $ unlines [missingAlpha, missingBeta] 
     (  _,  []) -> fail $ missingBeta 
     ( [],  _) -> fail $ missingAlpha 
     ((_:_:_), (_:_:_)) -> fail $ unlines [multipleAlpha, multipleBeta] 
     (  _, (_:_:_)) -> fail $ multipleBeta 
     ((_:_:_),  _) -> fail $ multipleAlpha 
     ( [x],  [y]) -> pure $ Result x y 
    where 
     missingAlpha  = message "No" "alpha" 
     missingBeta  = message "No" "beta" 
     multipleAlpha = message "Multiple" "alpha" 
     multipleBeta  = message "Multiple" "beta" 
     message x y  = concat [x," ",y," defined in input, ","exactly one ",y," definition required"] 

-- Type signature is important! 
segment :: Parsec String u (Either Alpha Beta) 
segment = undefined -- implementation irrelevant 

Я хотел бы, чтобы содержать ParseErrorмножественныеMessage значения в случае множественных отказов. Это должно быть возможным из-за существования функции addErrorMessage. Я не уверен, что нужно обеспечить множественный сбой в монадическом контексте Parsec, прежде чем результат будет реализован путем вызова parse.

Пример Функция:

fails :: [String] -> ParsecT s u m a 
fails = undefined -- Not sure how to define this! 

Как поставить несколькоMessage значения в ParseError результате в монадической контексте парсек в?

Answer 1

Я бы порекомендовал переход от Parsec t o более новый и более расширяемый Megaparsec библиотека.

This exact issue был разрешен с версии 4.2.0.0.

Несколько ошибок синтаксического анализа Message s может быть легко создан с помощью следующей функции:

fails :: MonadParsec m => [String] -> m a 
fails = failure . fmap Message 

Answer 2

fail в этом случае эквивалентен parserFail, определенных в Text.Parsec.Prim:

parserFail :: String -> ParsecT s u m a 
parserFail msg 
    = ParsecT $ \s _ _ _ eerr -> 
     eerr $ newErrorMessage (Message msg) (statePos s) 

С newErrorMessage и addErrorMessage как создать ParseError, этого изменение parserFail должна также работать:

parserFail' :: String -> ParsecT s u m a 
parserFail' msg 
    = ParsecT $ \s _ _ _ eerr -> 
     eerr $ theMessages s 
where 
    theMessages s = 
    addErrorMessage (Message "blah") $ 
     addErrorMessage (Expect "expected this") $ 
     newErrorMessage (Message msg) (statePos s) 

, который должен вставить 3 сообщения в список сообщений об ошибках.

Также в этом модуле, взгляните на label и labels, который единственное место, где addErrorMessage используется. labels - это всего лишь несколько сообщений версия оператора <?>. Обратите внимание, как он использует foldr создать сообщение об ошибке соединения:

labels :: ParsecT s u m a -> [String] -> ParsecT s u m a 
labels p msgs = 
    ParsecT $ \s cok cerr eok eerr -> 
    let eok' x s' error = eok x s' $ if errorIsUnknown error 
        then error 
        else setExpectErrors error msgs 
     eerr' err = eerr $ setExpectErrors err msgs 

    in unParser p s cok cerr eok' eerr' 

where 
    setExpectErrors err []   = setErrorMessage (Expect "") err 
    setExpectErrors err [msg]  = setErrorMessage (Expect msg) err 
    setExpectErrors err (msg:msgs) 
     = foldr (\msg' err' -> addErrorMessage (Expect msg') err') 
     (setErrorMessage (Expect msg) err) msgs 

Единственный Гатча, что вы должны иметь доступ к конструктору, который не экспортируемого Text.Parsec.Prim. Возможно, вы можете найти способ использовать labels или другим способом решения этой проблемы. В противном случае вы всегда можете добавить свою свою взломанную версию parsec с кодом.

Answer 3

Мы можем использовать тот факт, что ParsecT является экземпляром MonadPlus сочетать определение mzero с функцией labels для получения желаемого результата:

fails :: [String] -> ParsecT s u m a 
fails = labels mzero 

Примечание:ParseError имеет много Expect значения, не многие Message значения ...