Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
import Data.List (intercalate, sortOn)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.RTS.Events
import System.Environment (getArgs)
main :: IO ()
main = do
logfile <- head <$> getArgs
(Right (EventLog h (Data evs))) <- readEventLogFromFile logfile
let evs' = sortOn (\Event{evTime} -> evTime) . filter (isThreadEvent . evSpec) $ evs
threadNames = Map.fromList . concatMap tname $ evs'
counts = tail $ scanl (\o Event{evSpec} -> threadCounter evSpec + o) 0 evs' <> repeat 0
putStrLn "time,event,threadid,name,total"
putStrLn $ intercalate "\n" . filter (not.null) . map (intercalate "," . asCSV threadNames) $ zip evs' counts
where
threadCounter CreateThread{} = 1
threadCounter StopThread{status=ThreadFinished} = -1
threadCounter _ = 0
tname (Event{evSpec=ThreadLabel{..}}) = [(thread, threadlabel)]
tname _ = []
isThreadEvent CreateThread{} = True
isThreadEvent StopThread{status=ThreadFinished} = True
isThreadEvent ThreadLabel{..} = True
isThreadEvent _ = False
asCSV m (Event{evTime, evSpec=CreateThread{thread}},total) =
[show evTime, "create", show thread, n m thread, show total]
asCSV m (Event{evTime, evSpec=StopThread{thread, status=ThreadFinished}},total) =
[show evTime, "stop", show thread, n m thread, show total]
asCSV _ _ = []
n m i = Map.findWithDefault "" i m
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment