2

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

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|]
4

1 回答 1

2

这里存在三个大问题。

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

为了获得更理智的行为，您只能咬掉看起来像日期的字符串的开头并尝试解析它，例如：

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

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

请注意，这是一个快速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's。现在让我们在开头添加一个尝试：

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

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

现在让我们将 try 从 更改'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正确地跳过所有'c's 到第一个'a'，但随后它也首先消耗它'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)
  ...
于 2019-09-11T18:57:47.937 回答