parsing - 如何在 Parsec 的一元上下文中返回多个解析失败？

Question

我有一个我正在解析的语法，它由两个必需且唯一的逻辑部分组成，Alpha和 Beta .这些部分可以按任意顺序定义，Alpha之前 Beta或签证。我想为不太懂技术的用户提供可靠的错误消息。

在下面的示例中，存在多个解析失败的情况。我连接失败消息String s 与 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 的存在，这应该是可能的。功能。在调用 parse 实现结果之前，我不确定在 Parsec monadic 上下文中提供多个失败。 .

示例函数:

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

如何提供多个 Message 的值 ParseError 结果在 Parsec 的一元上下文中？

Answer 1

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只是多条消息 <?> 的版本运算符(operator)。注意它是如何使用 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

唯一的问题是您需要访问 ParsecT构造函数
不是由 Text.Parsec.Prim 导出的.或许你能找到使用 labels的方法
或解决该问题的另一种方法。否则你总是可以包括你的
自己的 parsec 的破解版本用你的代码。