parsec：带有有用错误消息的字符串选择解析器
parsec: string choice parser with useful error messages
让我们有以下解析器：
parser :: GenParser Char st String
parser = choice (fmap (try . string) ["head", "tail", "tales"]
<?> "expected one of ['head', 'tail', 'tales']")
当我们解析格式错误的输入 "ta" 时，它会 return 定义的错误，但由于回溯，它也会在第一个位置谈论 unexpected "t" 而不是 unexpected " "在位置 3.
是否有一种简单的（或内置的）方法来匹配多个预期字符串中的一个以产生良好的错误消息？我说的是显示正确的位置，在这种情况下类似于 expected "tail" or "tales" 而不是我们硬编码的错误消息。
旧的无效示例的旧答案
你安装了哪个版本的parsec？ 3.1.9 为我做了这个：
Prelude> :m + Text.Parsec Text.Parsec.String
Prelude Text.Parsec Text.Parsec.String> :set prompt Main>
Main> let parser = choice (map (try . string) ["foo", "fob", "bar"]) :: GenParser Char st String
Main> runParser parser () "Hey" "fo "
Left "Hey" (line 1, column 1):
unexpected " "
expecting "foo", "fob" or "bar"
Main> runParser parser () "Hey" "fo"
Left "Hey" (line 1, column 1):
unexpected end of input
expecting "foo", "fob" or "bar"
添加的 <?> error_message 除了将最后一行更改为 expecting expected one of ['foo', 'fob', 'bar'].
外，没有任何改变
如何从 Parsec 中提取更多错误
因此，在这种情况下，您不应相信错误消息是关于系统中可用信息的详尽无遗的情况。让我为 Text.Parsec.Error:Message 提供一个时髦的 Show 实例（如果它是 deriving (Show)，它基本上就是这样），这样您就可以看到 Parsec 的结果：
Main> :m + Text.Parsec.Error
Main> instance Show Message where show m = (["SysUnExpect", "UnExpect", "Expect", "Message"] !! fromEnum m) ++ ' ' : show (messageString m)
Main> case runParser parser () "" "ta" of Left pe -> errorMessages pe
[SysUnExpect "\"t\"",SysUnExpect "",SysUnExpect "",Expect "\"head\"",Expect "\"tail\"",Expect "\"tales\""]
你可以看到 secretly choice 正在将其所有信息转储到一堆并行消息中，并将 "unexpected end-of-file" 存储为 SysUnExpect "". ParseError 的 show 实例显然抓取了第一个 SysUnExpect 但所有 Expect 消息并将它们转储给你看。
目前执行此操作的确切函数是Text.Parsec.Error:showErrorMessages。错误消息应按顺序排列，并根据构造函数分为 4 个块； SysUnExpect 块是通过一个特殊的显示函数发送的，如果有真正的 UnExpect 元素，它会完全隐藏文本，否则只显示第一个 SysUnExpect 消息：
showSysUnExpect | not (null unExpect) ||
null sysUnExpect = ""
| null firstMsg = msgUnExpected ++ " " ++ msgEndOfInput
| otherwise = msgUnExpected ++ " " ++ firstMsg
可能值得重写它或向上游发送错误，因为这是一种奇怪的行为，而且数据结构不太适合它们。首先，简而言之，您的问题是：似乎每个 Message 都应该有一个 SourcePos，而不是每个 ParseError。
所以，有一个更早的步骤，mergeErrors，它更喜欢 ParseErrors 和后面的 SourcePos-es。这不会触发，因为消息没有 SourcePos，这意味着来自 choice 的所有错误都从字符串的开头开始，而不是从匹配的最大点开始。例如，您可以在解析 "tai":
时看到这一点
let parser = try (string "head") <|> choice (map (try . (string "ta" >>) . string) ["il", "les"]) :: GenParser Char st Strinh
其次，除此之外，我们可能应该将一起出现的消息绑定在一起（因此默认消息是 unexpected 't', expected "heads" | unexpected end-of-file, expected 'tails' | unexpected end-of-file, expected 'tales'，除非您用 <?> 覆盖它）。第三，可能应该导出 ParseError 构造函数；第四，Message 中的枚举类型真的很难看，最好放入 ParseError {systemUnexpected :: [Message], userUnexpected :: [Message], expected :: [Message], other :: [Message]} 之类的东西，即使是现在的版本。 （例如，如果消息未按特定顺序排列，ParseError 的当前 Show 将巧妙中断。）
同时，我建议您为 ParseError 编写自己的 show 变体。
编写一个正确执行此操作的函数并不难。我们一次只撕掉一个字符，使用 Data.Map 找到共享后缀：
{-# LANGUAGE FlexibleContexts #-}
import Control.Applicative
import Data.Map hiding (empty)
import Text.Parsec hiding ((<|>))
import Text.Parsec.Char
-- accept the empty string if that's a choice
possiblyEmpty :: Stream s m Char => [String] -> ParsecT s u m String
possiblyEmpty ss | "" `elem` ss = pure ""
| otherwise = empty
chooseFrom :: Stream s m Char => [String] -> ParsecT s u m String
chooseFrom ss
= foldWithKey (\h ts parser -> liftA2 (:) (char h) (chooseFrom ts) <|> parser)
empty
(fromListWith (++) [(h, [t]) | h:t <- ss])
<|> possiblyEmpty ss
我们可以在 ghci 中验证它是否成功匹配 "tail" 和 "tales"，并且它在以 [= 开头的解析失败后请求 i 或 l 17=]:
*Main> parse (chooseFrom ["head", "tail", "tales"]) "" "tail"
Right "tail"
*Main> parse (chooseFrom ["head", "tail", "tales"]) "" "tales"
Right "tales"
*Main> parse (chooseFrom ["head", "tail", "tales"]) "" "tafoo"
Left (line 1, column 3):
unexpected "f"
expecting "i" or "l"
这是我使用 Parsec 得到的结果：
λ> let parser = choice $ fmap (try . string) ["head", "tail", "tales"]
λ> parseTest parser "ta"
parse error at (line 1, column 1):
unexpected "t"
expecting "head", "tail" or "tales"
如果您想尝试现代版的 Parsec —
Megaparsec，你会结束
最多：
λ> let parser = choice $ fmap (try . string) ["head", "tail", "tales"]
λ> parseTest parser "ta"
1:1:
unexpected "ta" or 't'
expecting "head", "tail", or "tales"
这是怎么回事？首先，当我们解析有序的字符集合时，
与 string 一样，我们完全显示不正确的输入。这是多
我们认为更好，因为：
λ> parseTest (string "when" <* eof) "well"
1:1:
unexpected "we"
expecting "when"
我们指向单词的开头，我们展示了整个内容
不正确（直到第一个不匹配的字符）和整个事情我们
预计。我认为这更具可读性。仅基于 tokens 构建的解析器
以这种方式工作（也就是说，当我们试图匹配固定字符串时，
不区分大小写的变体可用）。
那么，unexpected "ta" or 't'呢，为什么会得到't'部分呢？这是
也绝对正确，因为有了你的备选方案集，
第一个字母 't' 本身也可能是意外的，因为你有
不以 't' 开头的替代方案。再看一个例子：
λ> let parser = choice $ fmap (try . string) ["tall", "tail", "tales"]
λ> parseTest parser "ta"
1:1:
unexpected "ta"
expecting "tail", "tales", or "tall"
或者：
λ> parseTest (try (string "lexer") <|> string "lexical") "lex"
1:1:
unexpected "lex"
expecting "lexer" or "lexical"
秒差距：
λ> parseTest (try (string "lexer") <|> string "lexical") "lex"
parse error at (line 1, column 1):
unexpected end of input
expecting "lexical"
既然可以“正常工作”，为什么还要煞费苦心地让它工作呢？
Megaparsec 还有很多其他很棒的东西，如果您有兴趣，
你可以了解更多
here。很难与之竞争
Parsec，但是我们已经编写了自己的教程并且我们的文档非常好。
让我们有以下解析器：
parser :: GenParser Char st String
parser = choice (fmap (try . string) ["head", "tail", "tales"]
<?> "expected one of ['head', 'tail', 'tales']")
当我们解析格式错误的输入 "ta" 时，它会 return 定义的错误，但由于回溯，它也会在第一个位置谈论 unexpected "t" 而不是 unexpected " "在位置 3.
是否有一种简单的（或内置的）方法来匹配多个预期字符串中的一个以产生良好的错误消息？我说的是显示正确的位置，在这种情况下类似于 expected "tail" or "tales" 而不是我们硬编码的错误消息。
旧的无效示例的旧答案
你安装了哪个版本的parsec？ 3.1.9 为我做了这个：
Prelude> :m + Text.Parsec Text.Parsec.String
Prelude Text.Parsec Text.Parsec.String> :set prompt Main>
Main> let parser = choice (map (try . string) ["foo", "fob", "bar"]) :: GenParser Char st String
Main> runParser parser () "Hey" "fo "
Left "Hey" (line 1, column 1):
unexpected " "
expecting "foo", "fob" or "bar"
Main> runParser parser () "Hey" "fo"
Left "Hey" (line 1, column 1):
unexpected end of input
expecting "foo", "fob" or "bar"
添加的 <?> error_message 除了将最后一行更改为 expecting expected one of ['foo', 'fob', 'bar'].
如何从 Parsec 中提取更多错误
因此，在这种情况下，您不应相信错误消息是关于系统中可用信息的详尽无遗的情况。让我为 Text.Parsec.Error:Message 提供一个时髦的 Show 实例（如果它是 deriving (Show)，它基本上就是这样），这样您就可以看到 Parsec 的结果：
Main> :m + Text.Parsec.Error
Main> instance Show Message where show m = (["SysUnExpect", "UnExpect", "Expect", "Message"] !! fromEnum m) ++ ' ' : show (messageString m)
Main> case runParser parser () "" "ta" of Left pe -> errorMessages pe
[SysUnExpect "\"t\"",SysUnExpect "",SysUnExpect "",Expect "\"head\"",Expect "\"tail\"",Expect "\"tales\""]
你可以看到 secretly choice 正在将其所有信息转储到一堆并行消息中，并将 "unexpected end-of-file" 存储为 SysUnExpect "". ParseError 的 show 实例显然抓取了第一个 SysUnExpect 但所有 Expect 消息并将它们转储给你看。
目前执行此操作的确切函数是Text.Parsec.Error:showErrorMessages。错误消息应按顺序排列，并根据构造函数分为 4 个块； SysUnExpect 块是通过一个特殊的显示函数发送的，如果有真正的 UnExpect 元素，它会完全隐藏文本，否则只显示第一个 SysUnExpect 消息：
showSysUnExpect | not (null unExpect) ||
null sysUnExpect = ""
| null firstMsg = msgUnExpected ++ " " ++ msgEndOfInput
| otherwise = msgUnExpected ++ " " ++ firstMsg
可能值得重写它或向上游发送错误，因为这是一种奇怪的行为，而且数据结构不太适合它们。首先，简而言之，您的问题是：似乎每个 Message 都应该有一个 SourcePos，而不是每个 ParseError。
所以，有一个更早的步骤，mergeErrors，它更喜欢 ParseErrors 和后面的 SourcePos-es。这不会触发，因为消息没有 SourcePos，这意味着来自 choice 的所有错误都从字符串的开头开始，而不是从匹配的最大点开始。例如，您可以在解析 "tai":
let parser = try (string "head") <|> choice (map (try . (string "ta" >>) . string) ["il", "les"]) :: GenParser Char st Strinh
其次，除此之外，我们可能应该将一起出现的消息绑定在一起（因此默认消息是 unexpected 't', expected "heads" | unexpected end-of-file, expected 'tails' | unexpected end-of-file, expected 'tales'，除非您用 <?> 覆盖它）。第三，可能应该导出 ParseError 构造函数；第四，Message 中的枚举类型真的很难看，最好放入 ParseError {systemUnexpected :: [Message], userUnexpected :: [Message], expected :: [Message], other :: [Message]} 之类的东西，即使是现在的版本。 （例如，如果消息未按特定顺序排列，ParseError 的当前 Show 将巧妙中断。）
同时，我建议您为 ParseError 编写自己的 show 变体。
编写一个正确执行此操作的函数并不难。我们一次只撕掉一个字符，使用 Data.Map 找到共享后缀：
{-# LANGUAGE FlexibleContexts #-}
import Control.Applicative
import Data.Map hiding (empty)
import Text.Parsec hiding ((<|>))
import Text.Parsec.Char
-- accept the empty string if that's a choice
possiblyEmpty :: Stream s m Char => [String] -> ParsecT s u m String
possiblyEmpty ss | "" `elem` ss = pure ""
| otherwise = empty
chooseFrom :: Stream s m Char => [String] -> ParsecT s u m String
chooseFrom ss
= foldWithKey (\h ts parser -> liftA2 (:) (char h) (chooseFrom ts) <|> parser)
empty
(fromListWith (++) [(h, [t]) | h:t <- ss])
<|> possiblyEmpty ss
我们可以在 ghci 中验证它是否成功匹配 "tail" 和 "tales"，并且它在以 [= 开头的解析失败后请求 i 或 l 17=]:
*Main> parse (chooseFrom ["head", "tail", "tales"]) "" "tail"
Right "tail"
*Main> parse (chooseFrom ["head", "tail", "tales"]) "" "tales"
Right "tales"
*Main> parse (chooseFrom ["head", "tail", "tales"]) "" "tafoo"
Left (line 1, column 3):
unexpected "f"
expecting "i" or "l"
这是我使用 Parsec 得到的结果：
λ> let parser = choice $ fmap (try . string) ["head", "tail", "tales"]
λ> parseTest parser "ta"
parse error at (line 1, column 1):
unexpected "t"
expecting "head", "tail" or "tales"
如果您想尝试现代版的 Parsec — Megaparsec，你会结束 最多：
λ> let parser = choice $ fmap (try . string) ["head", "tail", "tales"]
λ> parseTest parser "ta"
1:1:
unexpected "ta" or 't'
expecting "head", "tail", or "tales"
这是怎么回事？首先，当我们解析有序的字符集合时，
与 string 一样，我们完全显示不正确的输入。这是多
我们认为更好，因为：
λ> parseTest (string "when" <* eof) "well"
1:1:
unexpected "we"
expecting "when"
我们指向单词的开头，我们展示了整个内容
不正确（直到第一个不匹配的字符）和整个事情我们
预计。我认为这更具可读性。仅基于 tokens 构建的解析器
以这种方式工作（也就是说，当我们试图匹配固定字符串时，
不区分大小写的变体可用）。
那么，unexpected "ta" or 't'呢，为什么会得到't'部分呢？这是
也绝对正确，因为有了你的备选方案集，
第一个字母 't' 本身也可能是意外的，因为你有
不以 't' 开头的替代方案。再看一个例子：
λ> let parser = choice $ fmap (try . string) ["tall", "tail", "tales"]
λ> parseTest parser "ta"
1:1:
unexpected "ta"
expecting "tail", "tales", or "tall"
或者：
λ> parseTest (try (string "lexer") <|> string "lexical") "lex"
1:1:
unexpected "lex"
expecting "lexer" or "lexical"
秒差距：
λ> parseTest (try (string "lexer") <|> string "lexical") "lex"
parse error at (line 1, column 1):
unexpected end of input
expecting "lexical"
既然可以“正常工作”，为什么还要煞费苦心地让它工作呢？
Megaparsec 还有很多其他很棒的东西，如果您有兴趣， 你可以了解更多 here。很难与之竞争 Parsec，但是我们已经编写了自己的教程并且我们的文档非常好。