如何在Parsec的monadic上下文中返回多個解析失敗？

Question

我正在解析一個語法，該語法恰好由兩個必需且唯一的邏輯部分Alpha和Beta 。 這些部分可以按任何順序定義，即Beta或Visa-vera之前的Alpha 。 我想為技術不太熟練的用戶提供可靠的錯誤消息。

在下面的示例中，存在多個解析失敗的情況。 我將失敗消息String與unlines函數連接起來，並將所產生的串聯傳遞給fail組合器。 當在grammarDefinition上調用parse時，這將創建一個具有單個 Message值的ParseError值。

示例場景：

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單子上下文中提供多個失敗。

示例功能：

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只是<?>運算符的多消息版本。 請注意，它如何使用文件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導出的ParsecT構造Text.Parsec.Prim 。 也許您可以找到一種使用labels或解決該問題的另一種方法。 否則，您始終可以在代碼中包含自己的parsec hacked版本。

Answer 2

我們可以利用的事實， ParsecT是一個實例MonadPlus來定義結合mzero與功能labels以獲得期望的結果：

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

注意： ParseError具有許多Expect值，而沒有許多Message值...

Answer 3

我建議從Parsec過渡到更新和可擴展的Megaparsec庫。

從4.2.0.0版本4.2.0.0 此確切問題已得到解決。

可以使用以下函數輕松創建多個解析錯誤Message ：

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