跳过一切直到成功解析

Question

我想从这样的文本中解析所有的日子：

Ignore this
Also this

2019-09-05

More to ignore
2019-09-06
2019-09-07

使用 Trifecta，我定义了一个函数来解析一天：

dayParser :: Parser Day
dayParser = do
  dayString <- tillEnd
  parseDay dayString

tillEnd :: Parser String
tillEnd = manyTill anyChar (try eof <|> eol)

parseDay :: String -> Parser Day
parseDay s = maybe failure return dayMaybe
 where
  dayMaybe = parseTime' dayFormat s
  failure = unexpected $ "Failed to parse date. Expected format: " ++ dayFormat
  -- %-m makes the parser accept months consisting of a single digit
  dayFormat = "%Y-%-m-%-d"

eol :: Parser ()
eol = char '\n' <|> char '\r' >> return ()

-- "%Y-%-m-%-d" for example
type TimeFormat = String

-- Given a time format and a string, parses the string to a time.
parseTime' :: (Monad m, ParseTime t) => TimeFormat -> String -> m t
-- True means that the parser tolerates whitespace before and after the date
parseTime' = parseTimeM True defaultTimeLocale

以这种方式解析一天有效。我遇到的问题是忽略文本中不是一天的任何内容。

以下内容无效，因为它假设的文本块数不是一天：

daysParser :: Parser [Day]
daysParser = do
  -- Ignore everything that's not a day
  _    <- manyTill anyChar $ try dayParser
  days <- many $ token dayParser
  _    <- manyTill anyChar $ try dayParser
  -- There might be more days after this...
  return days

我认为有一种直接的方法可以用 Trifecta 表达这一点，但我似乎找不到它。

这是包括要解析的示例文本的整个模块：

{-# LANGUAGE QuasiQuotes #-}
module DateParser where
import           Text.RawString.QQ
import           Data.Time
import           Text.Trifecta
import           Control.Applicative            ( (<|>) )

-- "%Y-%-m-%-d" for example
type TimeFormat = String

dayParser :: Parser Day
dayParser = do
  dayString <- tillEnd
  parseDay dayString

tillEnd :: Parser String
tillEnd = manyTill anyChar (try eof <|> eol)

parseDay :: String -> Parser Day
parseDay s = maybe failure return dayMaybe
 where
  dayMaybe = parseTime' dayFormat s
  failure = unexpected $ "Failed to parse date. Expected format: " ++ dayFormat
  -- %-m makes the parser accept months consisting of a single digit
  dayFormat = "%Y-%-m-%-d"

eol :: Parser ()
eol = char '\n' <|> char '\r' >> return ()

-- Given a time format and a string, parses the string to a time.
parseTime' :: (Monad m, ParseTime t) => TimeFormat -> String -> m t
-- True means that the parser tolerates whitespace before and after the date
parseTime' = parseTimeM True defaultTimeLocale

daysParser :: Parser [Day]
daysParser = do
  -- Ignore everything that's not a day
  _    <- manyTill anyChar $ try dayParser
  days <- many $ token dayParser
  _    <- manyTill anyChar $ try dayParser
  -- There might be more days after this...
  return days

test = parseString daysParser mempty text1

text1 = [r|
Ignore this
Also this

2019-09-05

More to ignore
2019-09-06
2019-09-07|]

Answer 1

这里存在三个大问题。

首先，你定义dayParser的方式，它总是试图将文本的其余部分解析为一个约会。例如，如果您的输入文本是 "2019-01-01 foo bar"，那么 dayParser 将首先使用整个字符串，因此 dayString == "2019-01-01 foo bar"，然后将尝试将该字符串解析为日期。当然，这会失败。

为了有一个更明智的行为，你只能咬掉有点像日期的字符串的开头并尝试解析它，比如：

dayParser =
  parseDay =<< many (digit <|> char '-')

此实现会咬掉由数字和破折号组成的输入的开头，并尝试将其解析为日期。

请注意，这是一个 quick-n-dirty 实现。这是不精确的。例如，此实现将接受像 "2019-01-0123456" 这样的输入并尝试将其解析为日期，当然会失败。根据您的问题，不清楚您是否仍想解析 2019-01-01 并保留其余部分，或者您是否不想认为这是一个合适的日期。如果你想对此非常精确，你可以根据需要精确指定确切的格式，例如：

dayParser = do
  y <- count 4 digit
  void $ char '-'
  m <- try (count 2 digit) <|> count 1 digit
  void $ char '-'
  d <- try (count 2 digit) <|> count 1 digit
  parseDay $ y ++ "-" ++ m ++ "-" ++ d

此实现需要准确的日期格式。

其次，有一个逻辑问题：你的daysParser试图先解析一些垃圾，然后解析很多天，然后再解析一些垃圾。这种逻辑不允许许多日期之间有一些垃圾。

第三个问题要棘手得多。你看，try 组合子的工作方式——如果解析器失败，那么 try 将回滚输入位置，但如果解析器成功，那么输入 仍然被消耗 ！这意味着您不能使用 try 作为零消耗前瞻，就像您在 manyTill anyChar $ try dayParser 中尝试做的那样。这样的解析器将解析直到找到日期，然后它将消耗该日期，不为下一个解析器留下任何内容并导致它失败。

我会用一个更简单的例子来说明。考虑一下：

> parseString (many (char 'a')) mempty "aaa"
Success "aaa"

太棒了，它解析了三个 'a'。现在让我们在开头添加一个尝试：

> parseString (try (char 'b') *> many (char 'a')) mempty "aaa"
Success "aaa"

太棒了，这仍然有效：try 失败，然后我们像以前一样解析三个 'a'。

现在让我们将尝试从 'b' 更改为 'a':

> parseString (try (char 'a') *> many (char 'a')) mempty "aaa"
Success "aa"

看看发生了什么：try 已经消耗了第一个 'a'，只剩下两个被 many 解析。

我们甚至可以将其扩展为更类似于您的方法：

> p = manyTill anyChar (try (char 'a')) *> many (char 'a')

> parseString p mempty "aaa"
Success "aa"

> parseString p mempty "cccaaa"
Success "aa"

看看会发生什么？ manyTill 正确地跳过了第一个 'a' 之前的所有 'c'，但是随后它 也消耗了第一个 'a'!

（我认为）似乎没有理智的方式来进行这样的零消耗前瞻。您总是必须消耗第一个成功的命中。

如果遇到这个问题，我可能会求助于递归：一个一个地解析字符，在每一步中查看是否可以找到一天，然后连接到一个列表中。像这样：

data WhatsThis = AChar Char | ADay Day | EOF

daysParser = do
  r <- (ADay <$> dayParser) <|> (AChar <$> anyChar) <|> (EOF <$ eof)
  case r of
    ADay d -> do
      rest <- daysParser
      pure $ d : rest
    AChar _ ->
      daysParser
    EOF ->
      pure []

它尝试解析一天，如果失败，则跳过一个字符，除非没有更多的字符。如果日期解析成功，它会递归调用自身，然后将日期添加到递归调用的结果中。

请注意，这种方法不是很可组合：它总是消耗所有内容，直到输入结束。如果你想用其他东西组合它，你可能需要考虑用参数替换 eof：

daysParser stop = do
  r <- (ADay <$> dayParser) <|> (AChar <$> anyChar) <|> (EOF <$ stop)
  ...

跳过一切直到成功解析

Skip everything until a successful parse

parsing

haskell

trifecta