attoparsec高內存使用量讀取大文件

Question

我已經嘗試了許多方法來逐行解析文件內容，但目前無法正常工作，並且在運行時會使用大量內存（超過16GB）。

這是我想分析http://lpaste.net/144719

文件的一個子集，我要三兩種錯誤：

1）回溯錯誤（多線，其中第一個是像3））
2）與一種多線
3）單線錯誤單個錯誤

這是我的當前代碼：

import qualified Data.ByteString as B 
import Data.ByteString.Char8 as B8 hiding (lines, filter, unlines, head, readFile, take, length, 
              putStrLn, tail, map, concat, or, writeFile, intersperse, 
              groupBy, hGetContents) 
import qualified Data.Text as T 
import qualified Data.Text.IO as TIO 
import Data.Attoparsec.Text hiding (take) 
import Control.Applicative 
import Control.Monad (replicateM, mapM) 
import Data.Either (either) 
import Data.List (intersperse, groupBy) 
import System.Environment 
import qualified System.IO as SIO 

data TimeStamp = MkTimeStamp T.Text 
       deriving Show 

data LogFileInfo = BackTraceLineInfo T.Text 
       | BackTraceInfo TimeStamp T.Text T.Text [LogFileInfo] 
       | Error TimeStamp T.Text 
       | LargeError TimeStamp T.Text T.Text 
       deriving Show 

data LineType = SingleLineError TimeStamp T.Text 
       | DirectoryInfo T.Text 
       | ErrorInfo T.Text 
       | LineBackTraceInfo T.Text 
       | BackTraceString T.Text 
       | BackTraceLine T.Text 
       deriving Show 

parseTimeStamp :: Parser TimeStamp 
parseTimeStamp = do 
    year <- many digit 
    char '-' 
    month <- many digit 
    char '-' 
    day <- many digit 
    char ' ' 
    hour <- many digit 
    char ':' 
    minute <- many digit 
    char ':' 
    second <- many digit 
    char ' ' 
    (return . MkTimeStamp) $ T.pack $ year ++ "-" ++ month ++ "-" ++ day ++ " " ++ hour ++ ":" ++ minute ++ ":" ++ second 

parseError :: Parser LineType 
parseError = do 
    string $ T.pack "ERROR - " 
    timeStamp <- parseTimeStamp 
    errorInfo <- parseAnyLine 
    return $ SingleLineError timeStamp errorInfo 

parseDirectoryInfo :: Parser LineType 
parseDirectoryInfo = do 
    char '/' 
    directoryInfo <- parseAnyLine 
    (return . DirectoryInfo) $ T.append (T.pack "/") directoryInfo 

parseErrorInfo :: Parser LineType 
parseErrorInfo = do 
    errorInfo <- parseAnyLine 
    (return . ErrorInfo) errorInfo 

parseBackTraceString :: Parser LineType 
parseBackTraceString = do 
    let backTraceStr = T.pack " Backtrace: " 
    string backTraceStr 
    return $ BackTraceString backTraceStr 

parseBacktraceLine :: Parser LineType 
parseBacktraceLine = do 
    char '#' 
    number <- many1 digit 
    backTraceInfo <- parseAnyLine 
    let numberPart = T.pack $ '#' : number 
    return $ LineBackTraceInfo $ T.append numberPart backTraceInfo 

parseAnyLine :: Parser T.Text 
parseAnyLine = fmap T.pack $ many anyChar 

-- Skips n lines for allowing other parsers to succeed 
skipNLines n = replicateM n $ manyTill anyChar endOfLine 

-- performParser :: Parser a -> T.Text -> BackTraceInfo 
performParser = parseOnly 

getEitherRight :: Either a b -> b 
getEitherRight (Right b) = b 

parseLogFile :: [T.Text] -> [LineType] 
parseLogFile textxs = 
    let listaEithers = mapM (parseOnly $ 
          try parseError 
         <|> try parseDirectoryInfo 
         <|> try parseBacktraceLine 
         <|> try parseBackTraceString 
         <|> parseErrorInfo) textxs 
    in getEitherRight listaEithers 

customUnlines :: [String] -> String 
customUnlines []  = [] 
customUnlines (x:xs) = if x == "\n" 
         then '\n':customUnlines xs 
         else x ++ "\n" ++ customUnlines xs 

main = do 
    (fileName : _) <- getArgs 
    h <- SIO.openFile fileName SIO.ReadMode 
    SIO.hSetEncoding h SIO.latin1 
    fileContents <- SIO.hGetContents h 
    let titleLength   = length fileName 
     titleWithoutExtension = take (titleLength - 4) fileName 
     allNonEmptyLines  = map T.pack $ intersperse "\n" $ tail $ filter (/= "") $ lines fileContents -- [T.Text] 
     listParseResults  = parseLogFile allNonEmptyLines -- [LineType] 
     -- onlyModelErrors  = filter isModelError parseResult -- [LogFileInfo] 
     -- onlyOneRepresentative = map head $ groupBy equalErrors onlyModelErrors 
     listOfStrings   = map show listParseResults 
    writeFile (titleWithoutExtension ++ ".logsummary") $ customUnlines listOfStrings 

第一個問題是解析器不解析任何東西。第二個問題是使用16GB的RAM。如何改進我的方法？

Answer 1

至少有兩個問題 - writeFile和customUnlines。

writeFile需要寫之前收集所有的輸出，所以我會先看看這產生輸出：

h <- openFile "summary.txt" WriteMode 
forM_ listOfStrings (hPutStrLn h) 
hClose h 

這應該處理以流方式的日誌文件，如果listOfStrings是一個懶惰的名單。

假設這個工程，實現您customUnlines邏輯我這樣做：

h <- openFile "summary.txt" WriteMode 
forM_ listOfStrings $ \x -> do 
    if x == "\n" 
    then hPutStr h "\n" 
    else hPutStrLn h "\n" 
hClose h 

如果listOfStrings不是一個懶惰的名單，然後我需要你的進口，以進一步調試問題。

更新

事實證明，listOfStrings不是由於parseLogFile一個懶惰的名單。

請注意，listaEithers有類型Either String [LineType]。這意味着你必須在它返回之前解析所有的行。相反，你應該單獨分析每一行：

forM_ allNonEmptyLines $ \x -> do 
    case parseOnly parseLogLine x of 
    Left e -> error "oops" 
    Right a -> print a  -- a is a LineType 

這裏parseLogLine是：

parseLogLine = 
    try parseError 
    <|> try parseDirectoryInfo 
    <|> try parseBacktraceLine 
    <|> try parseBackTraceString 
    <|> parseErrorInfo