eventlog2html 0.4.0 → 0.5.0
raw patch · 8 files changed
+82/−24 lines, 8 filesdep +trie-simpledep ~containersdep ~ghc-eventsPVP ok
version bump matches the API change (PVP)
Dependencies added: trie-simple
Dependency ranges changed: containers, ghc-events
API changes (from Hackage documentation)
+ Eventlog.Events: instance GHC.Show.Show Eventlog.Events.CCSMap
+ Eventlog.Events: instance GHC.Show.Show Eventlog.Events.CCStack
+ Eventlog.Types: [hHeapProfileType] :: Header -> Text
+ Eventlog.Types: [hSamplingRate] :: Header -> Text
+ Eventlog.Types: instance GHC.Show.Show Eventlog.Types.Header
+ Eventlog.Types: instance GHC.Show.Show Eventlog.Types.ProfData
- Eventlog.Types: Header :: Text -> Text -> Text -> Text -> Int -> Header
+ Eventlog.Types: Header :: Text -> Text -> Text -> Text -> Text -> Text -> Int -> Header
Files
- CHANGELOG +8/−0
- eventlog2html.cabal +6/−4
- main/Main.hs +4/−7
- src/Eventlog/Data.hs +1/−1
- src/Eventlog/Events.hs +48/−9
- src/Eventlog/HeapProf.hs +1/−1
- src/Eventlog/HtmlTemplate.hs +10/−0
- src/Eventlog/Types.hs +4/−2
CHANGELOG view
@@ -1,3 +1,11 @@+0.5, released 2019-10-11++* Add some more metainformation to the header (sample mode and sample interval)+* Fix empty sample at start of eventlog+* Support for biographical and retaining profiling modes if using+at least GHC-8.10.+* Fix cost centre profiles to match the output of hp2pretty+ 0.4, released 2019-09-18 * BREAKING CHANGE: eventlog2html no longer includes traces which have been generated by "traceEvent" or "traceEventIO" from "Debug.Trace" by default.
eventlog2html.cabal view
@@ -1,5 +1,5 @@ Name: eventlog2html-Version: 0.4.0+Version: 0.5.0 Synopsis: Visualise an eventlog Description: eventlog2html is a library for visualising eventlogs. At the moment, the intended use is to visualise eventlogs@@ -41,10 +41,10 @@ base >= 4 && < 5, blaze-html >= 0.9.1 && < 0.10, bytestring >= 0.10.8 && < 0.11,- containers >= 0.6.0 && < 0.7,+ containers >= 0.5.0 && < 0.7, file-embed >= 0.0.11 && < 0.1, filepath >= 1.4.2 && < 1.5,- ghc-events >= 0.8.0 && < 0.10,+ ghc-events >= 0.10.0 && < 0.11, hashtables >= 1.2.3 && < 1.3, hvega >= 0.4.0 && < 0.5, mtl >= 2.2.2 && < 2.3,@@ -52,7 +52,8 @@ semigroups >= 0.18 && < 0.20, text >= 1.2.3 && < 1.3, time >= 1.8.0 && < 2.0,- vector >= 0.11+ vector >= 0.11,+ trie-simple >= 0.4 GHC-options: -Wall default-language: Haskell2010@@ -71,6 +72,7 @@ Eventlog.VegaTemplate Executable eventlog2html+ GHC-options: -Wall default-language: Haskell2010 HS-source-dirs: main Main-is: Main.hs
main/Main.hs view
@@ -3,17 +3,14 @@ module Main (main) where import Control.Monad-import Data.Aeson (encodeFile, Value, toJSON)+import Data.Aeson (encodeFile) import System.FilePath import System.Exit import System.IO import Eventlog.Args (args, Args(..))-import Eventlog.Bands (bands) import Eventlog.HtmlTemplate import Eventlog.Data-import Eventlog.Vega-import Eventlog.VegaTemplate import Eventlog.Types main :: IO ()@@ -23,9 +20,9 @@ argsToOutput a argsToOutput :: Args -> IO ()-argsToOutput a@Args{files = files, outputFile = Nothing} =- if | json a -> forM_ files $ \file -> doOneJson a file (file <.> "json")- | otherwise -> forM_ files $ \file -> doOneHtml a file (file <.> "html")+argsToOutput a@Args{files = files', outputFile = Nothing} =+ if | json a -> forM_ files' $ \file -> doOneJson a file (file <.> "json")+ | otherwise -> forM_ files' $ \file -> doOneHtml a file (file <.> "html") argsToOutput a@Args{files = [fin], outputFile = Just fout} = if | json a -> doOneJson a fin fout | otherwise -> doOneHtml a fin fout
src/Eventlog/Data.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Eventlog.Data (generateJson, generateJsonValidate ) where -import Prelude hiding (print, readFile)+import Prelude hiding (readFile) import Data.Aeson (Value(..), (.=), object) import Eventlog.Args (Args(..))
src/Eventlog/Events.hs view
@@ -21,13 +21,14 @@ import Data.Time import Data.Time.Clock.POSIX import qualified Data.Map as Map-import Data.Vector.Unboxed (Vector, (!?))+import Data.Vector.Unboxed (Vector, (!?), toList) import Data.Maybe import Data.Version import Text.ParserCombinators.ReadP import Control.Monad import Data.Char import System.IO+import qualified Data.Trie.Map as Trie type PartialHeader = Int -> Header @@ -73,7 +74,10 @@ data EL = EL { pargs :: !(Maybe [String]) , ident :: Maybe (Version, String)+ , samplingRate :: !(Maybe Word64)+ , heapProfileType :: !(Maybe HeapProfBreakdown) , ccMap :: !(Map.Map Word32 CostCentre)+ , ccsMap :: CCSMap , clocktimeSec :: !Word64 , samples :: !(Maybe FrameEL) , frames :: ![FrameEL]@@ -83,6 +87,24 @@ data FrameEL = FrameEL Word64 [Sample] deriving Show +data CCSMap = CCSMap (Trie.TMap Word32 CCStack) Int deriving Show++data CCStack = CCStack { ccsId :: Int, ccsName :: Text } deriving Show++getCCSId :: EL -> Vector Word32 -> (CCStack, EL)+getCCSId el@EL { ccsMap = (CCSMap trie uniq), ccMap = ccMap } k =+ let kl = toList k+ in case Trie.lookup kl trie of+ Just n -> (n, el)+ Nothing ->+ let new_stack = CCStack uniq name+ in (new_stack, el { ccsMap = CCSMap (Trie.insert kl new_stack trie) (uniq + 1) })+ where+ name = fromMaybe "MAIN" $ do+ cid <- (k !? 0)+ CC{label, modul} <- Map.lookup cid ccMap+ return $ modul <> "." <> label+ data CostCentre = CC { cid :: Word32 , label :: Text , modul :: Text@@ -92,6 +114,8 @@ initEL t = EL { pargs = Nothing , ident = Nothing+ , samplingRate = Nothing+ , heapProfileType = Nothing , clocktimeSec = 0 , samples = Nothing , frames = []@@ -99,6 +123,7 @@ , start = t , end = 0 , ccMap = Map.empty+ , ccsMap = CCSMap Trie.empty 0 } foldEvents :: Args -> [Event] -> EL@@ -123,13 +148,18 @@ ProgramArgs _ as -> addArgs as WallClockTime _ s _ -> addClocktime s -- Profiling Events- HeapProfBegin {} -> addFrame t+ HeapProfBegin { heapProfSamplingPeriod, heapProfBreakdown } -> addHeapProfBegin heapProfSamplingPeriod heapProfBreakdown HeapProfCostCentre cid l m loc _ -> addCostCentre cid (CC cid l m loc) HeapProfSampleBegin {} -> addFrame t+ HeapBioProfSampleBegin { heapProfSampleTime = t' } -> addFrame t' HeapProfSampleCostCentre _hid r d s -> addCCSample r d s HeapProfSampleString _hid res k -> addSample (Sample k (fromIntegral res)) _ -> id ++addHeapProfBegin :: Word64 -> HeapProfBreakdown -> EL -> EL+addHeapProfBegin sr hptype el = el { samplingRate = Just sr, heapProfileType = Just hptype }+ addIdent :: String -> EL -> EL addIdent s el = el { ident = parseIdent s } @@ -150,11 +180,10 @@ addCCSample :: Word64 -> Word8 -> Vector Word32 -> EL -> EL addCCSample res _sd st el =- fromMaybe (addSample (Sample "NONE" (fromIntegral res)) el) $ do- cid <- st !? 0- CC{label, modul} <- Map.lookup cid (ccMap el)- let fmtl = modul <> "." <> label- return $ addSample (Sample fmtl (fromIntegral res)) el+ let (CCStack stack_id tid, el') = getCCSId el st+ -- TODO: Can do better than this by differentiating normal samples form stack samples+ sample_string = (T.pack $ "(" ++ show stack_id ++ ") ") <> tid+ in addSample (Sample sample_string (fromIntegral res)) el' addClocktime :: Word64 -> EL -> EL@@ -221,6 +250,16 @@ elHeader EL{..} = let title = maybe "" (T.unwords . map T.pack) pargs date = formatDate clocktimeSec- in Header title date "" ""-+ profileType = ppHeapProfileType heapProfileType+ ppSamplingRate = T.pack . maybe "<Not available>" (show . fromNano) $ samplingRate+ in Header title date profileType ppSamplingRate "" "" +ppHeapProfileType :: Maybe HeapProfBreakdown -> Text+ppHeapProfileType (Just HeapProfBreakdownCostCentre) = "Cost centre profiling (implied by -hc)"+ppHeapProfileType (Just HeapProfBreakdownModule) = "Profiling by module (implied by -hm)"+ppHeapProfileType (Just HeapProfBreakdownClosureDescr) = "Profiling by closure description (implied by -hd)"+ppHeapProfileType (Just HeapProfBreakdownTypeDescr) = "Profiling by type (implied by -hy)"+ppHeapProfileType (Just HeapProfBreakdownRetainer) = "Retainer profiling (implied by -hr)"+ppHeapProfileType (Just HeapProfBreakdownBiography) = "Biographical profiling (implied by -hb)"+ppHeapProfileType (Just HeapProfBreakdownClosureType) = "Basic heap profile (implied by -hT)"+ppHeapProfileType Nothing = "<Not available>"
src/Eventlog/HeapProf.hs view
@@ -24,7 +24,7 @@ zipWith header [sJOB, sDATE, sSAMPLE_UNIT, sVALUE_UNIT] hs fs = chunkSamples ss in (- Header job date smpU valU+ Header job date (pack "") (pack "") smpU valU , fs )
src/Eventlog/HtmlTemplate.hs view
@@ -84,6 +84,16 @@ H.div ! class_ "row" $ do H.div ! class_ "column" $ do+ "Type of profile: "+ code $ toHtml $ hHeapProfileType header'++ H.div ! class_ "row" $ do+ H.div ! class_ "column" $ do+ "Sampling rate in seconds: "+ code $ toHtml $ hSamplingRate header'++ H.div ! class_ "row" $ do+ H.div ! class_ "column" $ do button ! class_ "tablink button-black" ! onclick "changeTab('areachart', this)" ! A.id "defaultOpen" $ "Area Chart" button ! class_ "tablink button-black" ! onclick "changeTab('normalizedchart', this)" $ "Normalized" button ! class_ "tablink button-black" ! onclick "changeTab('streamgraph', this)" $ "Streamgraph"
src/Eventlog/Types.hs view
@@ -7,10 +7,12 @@ Header { hJob :: Text , hDate :: Text+ , hHeapProfileType :: Text+ , hSamplingRate :: Text , hSampleUnit :: Text , hValueUnit :: Text , hCount :: Int- }+ } deriving Show data Sample = Sample Text Double deriving Show @@ -19,4 +21,4 @@ -- | A trace we also want to show on the graph data Trace = Trace Double Text deriving Show -data ProfData = ProfData Header (Map Text (Double, Double)) [Frame] [Trace]+data ProfData = ProfData Header (Map Text (Double, Double)) [Frame] [Trace] deriving Show