ParseEventLogs.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

import Control.Monad (when)
import qualified Data.ByteString.Lazy as L
import Data.List (foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector.Unboxed as VU
import Data.Word

import DataFrame ((|>), DataFrame)
import qualified DataFrame as D
import qualified DataFrame.Display.Web.Plot as Plt
import DataFrame.Functions ((.=), (.>=))
import qualified DataFrame.Functions as F

import GHC.RTS.Events hiding (header)
import GHC.RTS.Events.Incremental

data HeapSampleRow = HeapSampleRow
    { hTime :: !Word64
    , hLabel :: !Text
    , hBytes :: !Word64
    }
    deriving (Show)

data GcStatRow = GcStatRow
    { gTime :: !Word64
    , gGen :: !Int
    , gCopied :: !Word64
    , gSlop :: !Word64
    , gFrag :: !Word64
    }
    deriving (Show)

data BytesLocation = LIVE | BLOCK | HEAP deriving (Show, Eq)

data BytesRow = BytesRow
    { bTime :: !Word64
    , bLocation :: !BytesLocation
    , bBytes :: !Word64
    }
    deriving (Show)

data ParseState = ParseState
    { psHeapRows :: ![HeapSampleRow]
    , psGcRows :: ![GcStatRow]
    , psBytesRows :: ![BytesRow]
    , psCcMap :: !(Map Word32 Text)
    }

toHeapDataFrame :: [HeapSampleRow] -> DataFrame
toHeapDataFrame heapRows = D.fromRows ["time", "cc_label", "residency"] heapData
    where
        heapData = map (\r -> [D.toAny (hTime r), D.toAny (hLabel r), D.toAny (hBytes r)]) heapRows

toGcDataFrame :: [GcStatRow] -> DataFrame
toGcDataFrame gcRows = D.fromRows ["time", "generation", "copied", "slop", "frag"] gcData
    where
        gcData = map (\r -> [ D.toAny (gTime r), D.toAny (gGen r), D.toAny (gCopied r), D.toAny (gSlop r), D.toAny (gFrag r)]) gcRows

initialState :: ParseState
initialState = ParseState [] [] [] Map.empty

parseLogToRows :: [Event] -> ([HeapSampleRow], [GcStatRow], [BytesRow])
parseLogToRows events =
    let finalState = foldl' step initialState events
     in ( reverse (psHeapRows finalState)
        , reverse (psGcRows finalState)
        , reverse (psBytesRows finalState)
        )
  where
    step :: ParseState -> Event -> ParseState
    step st@ParseState{..} e =
        case evSpec e of
            HeapProfCostCentre ccId ccLabel ccModule _srcLoc _flags ->
                let fullLabel = T.pack (T.unpack ccLabel ++ " (" ++ T.unpack ccModule ++ ")")
                 in st{psCcMap = Map.insert ccId fullLabel psCcMap}
            HeapProfSampleCostCentre{..} ->
                let
                    topCcId =
                        if VU.null heapProfStack
                            then Nothing
                            else Just (VU.head heapProfStack)
                    label = case topCcId of
                        Nothing -> "UNKNOWN (empty stack)"
                        Just ccId ->
                            fromMaybe
                                ("CC#" <> T.pack (show ccId))
                                (Map.lookup ccId psCcMap)
                    row =
                        HeapSampleRow
                            { hTime = nsToSec (evTime e)
                            , hLabel = label
                            , hBytes = heapProfResidency
                            }
                 in
                    st{psHeapRows = row : psHeapRows}
            HeapProfSampleString{..} ->
                let row =
                        HeapSampleRow
                            { hTime = nsToSec (evTime e)
                            , hLabel = heapProfLabel
                            , hBytes = heapProfResidency
                            }
                 in st{psHeapRows = row : psHeapRows}
            GCStatsGHC{..} ->
                let row =
                        GcStatRow
                            { gTime = nsToSec (evTime e)
                            , gGen = fromIntegral gen
                            , gCopied = copied
                            , gSlop = slop
                            , gFrag = frag
                            }
                 in st{psGcRows = row : psGcRows}
            HeapLive _capset b ->
                let row =
                        BytesRow
                            { bTime = nsToSec (evTime e)
                            , bLocation = LIVE
                            , bBytes = b
                            }
                 in st{psBytesRows = row : psBytesRows}
            HeapSize _capset b ->
                let row =
                        BytesRow
                            { bTime = nsToSec (evTime e)
                            , bLocation = HEAP
                            , bBytes = b
                            }
                 in st{psBytesRows = row : psBytesRows}
            BlocksSize _capset b ->
                let row =
                        BytesRow
                            { bTime = nsToSec (evTime e)
                            , bLocation = BLOCK
                            , bBytes = b
                            }
                 in st{psBytesRows = row : psBytesRows}
            _ -> st

    nsToSec :: Timestamp -> Word64
    nsToSec ns = fromIntegral ns `div` 1_000_000_000