attoparsec высокая память использования чтения огромный файл

Question

Я пробовал много подходов для синтаксического разбора содержимого файла, но в настоящее время не работает, и когда он работает, используется много памяти (более 16 ГБ).

Это подмножество файла Я хочу, чтобы разобрать 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 

Первая проблема заключается в том, что синтаксический анализатор не разбирает ничего. И вторая проблема заключается в том, что используется 16 ГБ ОЗУ. Как улучшить мой подход?

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 не ленивым список, то мне нужно ваши импорта для дальнейшей отладки проблемы.

Update

Оказывается, что 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