parsing - 使用 attoparsec 对解析后的数据进行操作

Question

背景

我使用 attoparsec 编写了一个日志文件解析器。我所有较小的解析器都成功了，组成的最终解析器也是如此。我已通过 tests 确认了这一点。但我在使用解析的流执行操作时遇到了困难。

我尝试过的

我首先尝试将成功解析的输入传递给函数。但似乎得到的只是 Done ()，我认为这意味着此时日志文件已被消耗。

prepareStats :: Result Log -> IO ()
prepareStats r =
case r of
    Fail _ _ _ -> putStrLn $ "Parsing failed"
    Done _ parsedLog -> putStrLn "Success" -- This now has a [LogEntry] array. Do something with it.

main :: IO ()
main = do
[f] <- getArgs
logFile <- B.readFile (f :: FilePath)
let results = parseOnly parseLog logFile
putStrLn "TBC"

我正在尝试做什么

我想在使用输入时从日志文件中积累一些统计信息。例如，我正在解析响应代码，我想计算有多少个 2** 响应以及有多少个 4/5** 响应。我正在解析每个响应以整数形式返回的字节数，并且我想有效地对这些字节数进行求和(听起来像 foldl'？)。我定义了这样的数据类型:

data Stats = Stats {
    successfulRequestsPerMinute :: Int
  , failingRequestsPerMinute    :: Int
  , meanResponseTime            :: Int
  , megabytesPerMinute          :: Int
  } deriving Show

我想在解析输入时不断更新它。但在我消费时执行操作的部分是我陷入困境的地方。到目前为止，print 是我成功地将输出传递给的唯一函数，它通过在打印输出之前返回 Done 来表明解析已成功。

我的主要解析器如下所示:

parseLogEntry :: Parser LogEntry
parseLogEntry = do
ip <- logItem
_ <- char ' '
logName <- logItem
_ <- char ' '
user <- logItem
_ <- char ' '
time <- datetimeLogItem
_ <- char ' '
firstLogLine <- quotedLogItem
_ <- char ' '
finalRequestStatus <- intLogItem
_ <- char ' '
responseSizeB <- intLogItem
_ <- char ' '
timeToResponse <- intLogItem
return $ LogEntry ip logName user time firstLogLine finalRequestStatus responseSizeB timeToResponse

type Log = [LogEntry]

parseLog :: Parser Log
parseLog = many $ parseLogEntry <* endOfLine

期望的结果

我想将每个解析的行传递给一个函数来更新上述数据类型。理想情况下，我希望它具有非常高的内存效率，因为它将在大文件上运行。

Answer 1

您必须建立解析单个日志条目而不是日志条目列表的单元。

这并不漂亮，但这里是如何交错解析和处理的示例:

(取决于 bytestring、attoparsec 和 mtl)

{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-}

import qualified Data.ByteString.Char8 as BS
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Attoparsec.ByteString.Char8 hiding (takeWhile)
import Data.Char
import Control.Monad.State.Strict

aWord :: Parser BS.ByteString
aWord = skipSpace >> A.takeWhile isAlphaNum

getNext :: MonadState [a] m => m (Maybe a)
getNext = do
  xs <- get
  case xs of
    [] -> return Nothing
    (y:ys) -> put ys >> return (Just y)

loop iresult =
  case iresult of
    Fail _ _ msg  -> error $ "parse failed: " ++ msg
    Done x' aword -> do lift $ process aword; loop (parse aWord x')
    Partial _     -> do
      mx <- getNext
      case mx of
        Just y  -> loop (feed iresult y)
        Nothing -> case feed iresult BS.empty of
                     Fail _ _ msg  -> error $ "parse failed: " ++ msg
                     Done x' aword -> do lift $ process aword; return ()
                     Partial _     -> error $ "partial returned"  -- probably can't happen

process :: Show a => a -> IO ()
process w = putStrLn $ "got a word: " ++ show w

theWords = map BS.pack [ "this is a te", "st of the emergency ", "broadcasting sys", "tem"]


main = runStateT (loop (Partial (parse aWord))) theWords

注释:

• 我们一次解析一个aWord，并在识别每个单词后调用process。
• 当解析器返回 Partial 时，使用 feed 为解析器提供更多输入。
• 当没有剩余输入时，向解析器提供一个空字符串。
• 当返回Done时，处理识别出的单词并继续parse aWord。
• getNext 只是获取下一个输入单元的一元函数的示例。将其替换为您自己的版本 - 即从文件中读取下一行的版本。

更新

这是一个使用 parseWith 的解决方案，如 @dfeuer 建议:

noMoreInput = fmap null get

loop2 x = do
  iresult <- parseWith (fmap (fromMaybe BS.empty) getNext) aWord x
  case iresult of
    Fail _ _ msg  -> error $ "parse failed: " ++ msg
    Done x' aword -> do lift $ process aword;
                        if BS.null x'
                           then do b <- noMoreInput
                                   if b then return ()
                                        else loop2 x'
                           else loop2 x'
    Partial _     -> error $ "huh???" -- this really can't happen

main2 = runStateT (loop2 BS.empty) theWords