Анализ производительности сворачивания с использованием ключей map и ByteString

У меня есть небольшой скрипт для чтения, анализа и получения какой-то интересной (не совсем) статистики из файла журнала apache. Пока что я сделал два простых варианта: общее количество байтов, отправленных во всех запросах в файле журнала, и 10 самых распространенных IP-адресов.

Первый «режим» - это просто сумма всех проанализированных байтов. Второй - это загиб карты (Data.Map) с использованием insertWith (+) 1' для подсчета вхождений.

Первый запускается, как я и ожидал, большую часть времени, потраченного на синтаксический анализ, в постоянном пространстве.

42 359 709 344 байта, выделенные в куче 72 405 840 байтов, скопированных во время GC 113 712 байтов, максимальное время размещения (1553 выборки) 145 872 байта, максимальное время ожидания 2 МБ общей используемой памяти (0 МБ потеряно из-за фрагментации)

Поколение 0: 76311 собраний,
0 параллелей, 0,89 с, прошло 0,99 с.
Поколение 1: 1553 собраний, 0 параллелей, 0,21 с, прошло 0,22 с.

Время INIT 0,00 с (прошло 0,00 с) Время MUT 21,76 с (прошло 24,82 с) Время GC 1,10 с (прошло 1,20 с) Время выхода
0,00 с (прошло 0,00 с) Общее время 22,87 с (прошло 26,02 с)

% Времени GC 4,8% (прошло 4,6%)

Скорость выделения 1 946 258 962 байта в секунду MUT

Производительность 95,2% от общего числа пользователей, 83,6% от общего количества затраченных средств

Однако второй нет!

49 398 834 152 байта, выделенные в куче 580 579 208 байтов, скопированных во время GC 718 385 088 байтов максимальное время размещения (15 выборок) 134 532 128 байтов максимальное временное пространство 1393 МБ общей используемой памяти (172 МБ потеряно из-за фрагментации)

Поколение 0: 91275 коллекций,
0 параллелей, 252,65 с, прошло 254,46 с
Поколение 1:15 коллекций, 0 параллелей, 0,12 с, 0,12 с истекло

Время INIT 0,00 с (прошло 0,00 с) Время MUT 41,11 с (прошло 48,87 с) Время GC 252,77 с (прошло 254,58 с) Время выхода
0,00 с (прошло 0,01 с) Общее время 293,88 с (прошло 303,45 с)

% Времени GC 86,0% (прошло 83,9%)

Скорость выделения 1201635385 байт в секунду MUT

Производительность 14,0% от общего числа пользователей, 13,5% от общего числа затраченных

А вот и код.

{-# LANGUAGE OverloadedStrings #-}

module Main where

import qualified Data.Attoparsec.Lazy as AL
import Data.Attoparsec.Char8 hiding (space, take)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad (liftM)
import System.Environment (getArgs)
import Prelude hiding (takeWhile)
import qualified Data.Map as M
import Data.List (foldl', sortBy)
import Text.Printf (printf)
import Data.Maybe (fromMaybe)

type Command = String

data LogLine = LogLine {
    getIP     :: S.ByteString,
    getIdent  :: S.ByteString,
    getUser   :: S.ByteString,
    getDate   :: S.ByteString,
    getReq    :: S.ByteString,
    getStatus :: S.ByteString,
    getBytes  :: S.ByteString,
    getPath   :: S.ByteString,
    getUA     :: S.ByteString
} deriving (Ord, Show, Eq)

quote, lbrack, rbrack, space :: Parser Char
quote  = satisfy (== '\"')
lbrack = satisfy (== '[')
rbrack = satisfy (== ']')
space  = satisfy (== ' ')

quotedVal :: Parser S.ByteString
quotedVal = do
    quote
    res <- takeTill (== '\"')
    quote
    return res

bracketedVal :: Parser S.ByteString
bracketedVal = do
    lbrack
    res <- takeTill (== ']')
    rbrack
    return res

val :: Parser S.ByteString
val = takeTill (== ' ')

line :: Parser LogLine
l    ine = do
    ip <- val
    space
    identity <- val
    space
    user <- val
    space
    date <- bracketedVal
    space
    req <- quotedVal
    space
    status <- val
    space
    bytes <- val
    (path,ua) <- option ("","") combined
    return $ LogLine ip identity user date req status bytes path ua

combined :: Parser (S.ByteString,S.ByteString)
combined = do
    space
    path <- quotedVal
    space
    ua <- quotedVal
    return (path,ua)

countBytes :: [L.ByteString] -> Int
countBytes = foldl' count 0
    where
        count acc l = case AL.maybeResult $ AL.parse line l of
            Just x  -> (acc +) . maybe 0 fst . S.readInt . getBytes $ x
            Nothing -> acc

countIPs :: [L.ByteString] -> M.Map S.ByteString Int
countIPs = foldl' count M.empty
    where
        count acc l = case AL.maybeResult $ AL.parse line l of
            Just x -> M.insertWith' (+) (getIP x) 1 acc
            Nothing -> acc

---------------------------------------------------------------------------------

main :: IO ()
main = do
  [cmd,path] <- getArgs
  dispatch cmd path

pretty :: Show a => Int -> (a, Int) -> String
pretty i (bs, n) = printf "%d: %s, %d" i (show bs) n

dispatch :: Command -> FilePath -> IO ()
dispatch cmd path = action path
    where
        action = fromMaybe err (lookup cmd actions)
        err    = printf "Error: %s is not a valid command." cmd

actions :: [(Command, FilePath -> IO ())]
actions = [("bytes", countTotalBytes)
          ,("ips",  topListIP)]

countTotalBytes :: FilePath -> IO ()
countTotalBytes path = print . countBytes . L.lines =<< L.readFile path

topListIP :: FilePath -> IO ()
topListIP path = do
    f <- liftM L.lines $ L.readFile path
    let mostPopular (_,a) (_,b) = compare b a
        m = countIPs f
    mapM_ putStrLn . zipWith pretty [1..] . take 10 . sortBy mostPopular . M.toList $ m

Редактировать:

Добавление + RTS -A16M снизило GC до 20%. Использование памяти конечно же без изменений.