eventlog2html 0.8.3 → 0.9.0

raw patch · 11 files changed

+176/−52 lines, 11 filesdep ~ghc-eventsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-events

API changes (from Hackage documentation)

Files

• CHANGELOG +6/−1
• eventlog2html.cabal +2/−2
• main/Main.hs +1/−1
• src/Eventlog/Data.hs +3/−2
• src/Eventlog/Detailed.hs +4/−5
• src/Eventlog/Events.hs +30/−16
• src/Eventlog/HeapProf.hs +1/−1
• src/Eventlog/HtmlTemplate.hs +37/−23
• src/Eventlog/Types.hs +8/−0
• src/Eventlog/Vega.hs +13/−1
• src/Eventlog/VegaTemplate.hs +71/−0

@@ -1,4 +1,9 @@-0.8.3+0.9 release 2021-03-17++* Add support for -hi profiling+* Add a chart to show memory usage vs live bytes++0.8.3 release 2020-12-29  * Add `defaultArgs` and `generateJsonData` for using eventlog2html as a library * Update to hvega-0.11

@@ -1,6 +1,6 @@ cabal-version:       2.4 Name:                eventlog2html-Version:             0.8.3+Version:             0.9.0 Synopsis:            Visualise an eventlog Description:         eventlog2html is a library for visualising eventlogs.                      At the moment, the intended use is to visualise eventlogs@@ -43,7 +43,7 @@     containers           >= 0.5.0 && < 0.7,     file-embed           >= 0.0.11 && < 0.1,     filepath             >= 1.4.2 && < 1.5,-    ghc-events           >= 0.13.0 && < 0.14,+    ghc-events           >= 0.16.0 && < 0.17,     hashtables           >= 1.2.3 && < 1.3,     hvega                >= 0.11.0 && < 0.12,     mtl                  >= 2.2.2 && < 2.3,

@@ -45,7 +45,7 @@   writeFile fout html   where     checkTraces :: ProfData -> IO ()-    checkTraces (ProfData _ _ _ _ ts _) =+    checkTraces (ProfData _ _ _ _ ts _ _) =       if length ts > 1000         then hPutStrLn stderr               "More than 1000 traces, consider reducing using -i or -x"

@@ -19,12 +19,13 @@ import Text.Blaze.Html  generateJsonData :: Args -> ProfData -> IO (Header, Value, Maybe Value, Maybe Html)-generateJsonData a (ProfData h binfo ccMap fs traces _ipes) = do+generateJsonData a (ProfData h binfo ccMap fs traces heap_info ipes) = do   let keeps = pruneBands a binfo       bs = bands h (Map.map fst keeps) fs       combinedJson = object [           "samples" .= bandsToVega keeps bs         , "traces"  .= tracesToVega traces+        , "heap"    .= heapToVega heap_info         ]       mdescs =         sortBy (flip (comparing (fst . snd))) $ Map.toList keeps@@ -34,7 +35,7 @@                 _ -> Nothing    let use_ipes = case hHeapProfileType h of-                   --Just HeapProfBreakdownInfoTable -> Just ipes+                   Just HeapProfBreakdownInfoTable -> Just ipes                    _ -> Nothing       desc_buckets = pruneDetailed a binfo       bs' = bands h (Map.map fst desc_buckets) fs

@@ -59,7 +59,7 @@       numTh "Slope"       numTh "Fit (R²)"     Map.foldrWithKey (\k a res -> renderEntry k a >> res) (mempty :: Html) cs-  H.script $ preEscapedToHtml (initTable (isJust mipes))+  H.script $ preEscapedToHtml initTable   where     numTh lbl = H.th ! H.dataAttribute "sortas" "numeric" $ lbl     trunc :: Double -> Fixed E2@@ -88,7 +88,6 @@       H.td ""       H.td ""       H.td ""-      H.td ""      renderEntry (Bucket k) (mitl, (n, BucketInfo _ _ tot std mg)) = do           let (a, b, r2) =@@ -114,10 +113,10 @@     rdouble = T.pack . showFixed True . realToFrac @Double @(Fixed E2)     renderLine (x,y) = rdouble x <> ":" <> rdouble y -initTable :: Bool -> T.Text-initTable b = "$(document).ready(function() {\+initTable :: T.Text+initTable = "$(document).ready(function() {\         \$(\".closureTable\").fancyTable({\-        \    sortColumn:" <> (if b then "8" else "3") <> ",\+        \    sortColumn: 1,\         \    pagination: true,\         \    perPage:10,\         \    globalSearch:false,\

@@ -6,7 +6,7 @@ {-# LANGUAGE TypeApplications #-} module Eventlog.Events(chunk) where -import GHC.RTS.Events hiding (Header, header)+import GHC.RTS.Events hiding (Header, header, liveBytes, blocksSize) import Prelude hiding (init, lookup) import qualified Data.Text as T import qualified Data.Text.IO as T@@ -31,7 +31,6 @@ import qualified Data.Trie.Map as Trie import Data.Map.Merge.Lazy import Data.Functor.Identity-import GHC.Exts.Heap.ClosureTypes  type PartialHeader = Int -> Header @@ -42,7 +41,7 @@ chunk :: Args -> FilePath -> IO ProfData chunk a f = do   (EventLog _ e) <- either error id <$> readEventLogFromFile f-  (ph, bucket_map, ccMap, frames, traces, ipes) <- eventsToHP a e+  (ph, bucket_map, ccMap, frames, traces, ipes, hdata) <- eventsToHP a e   let (counts, totals) = total frames       -- If both keys are present, combine       combine = zipWithAMatched (\_ (t, mt) (tot, sd, g) -> Identity $ BucketInfo t mt tot sd g)@@ -55,7 +54,7 @@       combineMissingDesc (Bucket t) (tot, sd, g) = Identity (BucketInfo t Nothing tot sd g)        binfo = merge (traverseMissing combineMissingTotal) (traverseMissing combineMissingDesc) combine bucket_map totals-  return $ (ProfData (ph counts) binfo ccMap frames traces ipes)+  return $ (ProfData (ph counts) binfo ccMap frames traces hdata ipes)  checkGHCVersion :: EL -> Maybe Text checkGHCVersion EL { ident = Just (version,_)}@@ -72,14 +71,15 @@             <> ", which does not support biographical or retainer profiling." checkGHCVersion _ = Nothing -eventsToHP :: Args -> Data -> IO (PartialHeader, BucketMap, Map.Map Word32 CostCentre, [Frame], [Trace], Map.Map InfoTablePtr InfoTableLoc)+eventsToHP :: Args -> Data -> IO (PartialHeader, BucketMap, Map.Map Word32 CostCentre, [Frame], [Trace], Map.Map InfoTablePtr InfoTableLoc, HeapInfo) eventsToHP a (Data es) = do   let       el@EL{..} = foldEvents a es       fir = Frame (fromNano start) []       las = Frame (fromNano end) []   mapM_ (T.hPutStrLn stderr) (checkGHCVersion el)-  return $ (elHeader el, elBucketMap el, ccMap, fir : reverse (las: normalise frames) , traces, Map.fromList ipes)+  let heapInfo = HeapInfo (reverse heapSize) (reverse blocksSize) (reverse liveBytes)+  return $ (elHeader el, elBucketMap el, ccMap, fir : reverse (las: normalise frames) , reverse traces, Map.fromList ipes, heapInfo)  normalise :: [FrameEL] -> [Frame] normalise = map (\(FrameEL t ss) -> Frame (fromNano t) ss)@@ -89,6 +89,9 @@ data EL = EL   { pargs :: !(Maybe [Text])   , programInvocation :: !(Maybe FilePath)+  , heapSize :: ![HeapSample]+  , liveBytes :: ![HeapSample]+  , blocksSize :: ![HeapSample]   , ident :: Maybe (Version, Text)   , samplingRate :: !(Maybe Word64)   , heapProfileType :: !(Maybe HeapProfBreakdown)@@ -142,6 +145,9 @@   , heapProfileType = Nothing   , clocktimeSec = 0   , samples = Nothing+  , heapSize = []+  , liveBytes = []+  , blocksSize = []   , frames = []   , traces = []   , ipes = []@@ -182,17 +188,18 @@       HeapBioProfSampleBegin { heapProfSampleTime = t' } -> addFrame t'       HeapProfSampleCostCentre _hid r d s -> addCCSample r d s       HeapProfSampleString _hid res k -> addSample (Sample (Bucket k) (fromIntegral res))-      --IPE ptr name desc ty lbl smod sloc -> addInfoTableLoc (InfoTablePtr ptr,-      --                                        InfoTableLoc name (parseClosureType desc) ty lbl smod sloc)+      InfoTableProv ptr name desc ty lbl smod sloc -> addInfoTableLoc (InfoTablePtr ptr,+                                              InfoTableLoc name (parseClosureType desc) ty lbl smod sloc)+      HeapSize _ b -> addHeapSize t b+      HeapLive _ b -> addHeapLive t b+      BlocksSize _ b -> addBlocksSize t b       _ -> id -_parseClosureType :: Text -> ClosureType--- IPEs do not distinguish different CONSTR types, yet-_parseClosureType "0" = CONSTR-_parseClosureType ct = toEnum . read @Int . T.unpack $ ct+parseClosureType :: Int -> ClosureType+parseClosureType ct = toEnum ct -_addInfoTableLoc :: (InfoTablePtr, InfoTableLoc) -> EL -> EL-_addInfoTableLoc itl el = el { ipes = itl : ipes el }+addInfoTableLoc :: (InfoTablePtr, InfoTableLoc) -> EL -> EL+addInfoTableLoc itl el = el { ipes = itl : ipes el }  addHeapProfBegin :: Word64 -> HeapProfBreakdown -> EL -> EL addHeapProfBegin sr hptype el = el { samplingRate = Just sr, heapProfileType = Just hptype }@@ -231,7 +238,16 @@ addInvocation :: String -> EL -> EL addInvocation inv el = el { programInvocation = Just inv } +addHeapLive :: Timestamp -> Word64 -> EL -> EL+addHeapLive t s el = el { liveBytes = HeapSample (fromNano t) s : liveBytes el } +addHeapSize :: Timestamp -> Word64 -> EL -> EL+addHeapSize t s el = el { heapSize = HeapSample (fromNano t) s : heapSize el }++addBlocksSize :: Timestamp -> Word64 -> EL -> EL+addBlocksSize t s el = el { blocksSize = HeapSample (fromNano t) s : blocksSize el}++ -- | Decide whether to include a trace based on the "includes" and -- "excludes" options. --@@ -295,5 +311,3 @@  elBucketMap :: EL -> BucketMap elBucketMap = bucketMap--

@@ -17,7 +17,7 @@       -- Heap profiles don't contain any other information than the simple bucket name       binfo = Map.mapWithKey (\(Bucket k) (t,s,g) -> BucketInfo k Nothing t s g) totals   -- Heap profiles do not support traces-  return (ProfData (ph counts) binfo mempty fs [] mempty)+  return (ProfData (ph counts) binfo mempty fs [] (HeapInfo [] [] []) mempty)  chunkT :: Text -> (Int -> Header, [Frame]) chunkT s =

@@ -46,27 +46,28 @@   , "console.log(colour_scheme);" ]  -data_sets :: IncludeTraceData -> [Text]-data_sets itd = ["res.view.insert(\"data_json_samples\", data_json.samples)"]-    ++ ["; res.view.insert(\"data_json_traces\", data_json.traces)" | TraceData <- [itd] ]+data_sets :: [Text] -> [Text]+data_sets itd = Prelude.map line itd+ where+  line t = "res.view.insert(\"data_json_" <> t <>"\", data_json."<> t <>");"  data IncludeTraceData = TraceData | NoTraceData -encloseScript :: IncludeTraceData -> VizID -> Text -> Html-encloseScript = encloseScriptX True+encloseScript :: [Text] -> VizID -> Text -> Html+encloseScript = encloseScriptX -encloseRawVegaScript :: IncludeTraceData -> VizID -> Text -> Html-encloseRawVegaScript = encloseScriptX False+encloseRawVegaScript :: VizID -> Text -> Html+encloseRawVegaScript = encloseScriptX [] -encloseScriptX :: Bool -> IncludeTraceData -> VizID -> Text -> Html-encloseScriptX insert_data_sets itd vid vegaspec = preEscapedToHtml $ T.unlines ([+encloseScriptX :: [Text] -> VizID -> Text -> Html+encloseScriptX insert_data_sets vid vegaspec = preEscapedToHtml $ T.unlines ([   "var yourVlSpec" `append` vidt `append`"= " `append` vegaspec  `append` ";"   , "vegaEmbed('#vis" `append` vidt `append` "', yourVlSpec" `append` vidt `append` ")"   , ".then((res) => { " ] -- For the 4 vega lite charts we dynamically insert the data after the -- chart is created to avoid duplicating it. For the vega chart, this -- causes a harmless error so we just don't do it.-  ++ (if insert_data_sets then data_sets itd else []) +++  ++ (data_sets insert_data_sets) ++   [ "; res.view.resize()"   , "; res.view.runAsync()"   , "})" ])@@ -146,47 +147,60 @@         button ! class_ "tablink button-black" ! onclick "changeTab('normalizedchart', this)" $ "Normalized"         button ! class_ "tablink button-black" ! onclick "changeTab('streamgraph', this)" $ "Streamgraph"         button ! class_ "tablink button-black" ! onclick "changeTab('linechart', this)" $ "Linechart"+        button ! class_ "tablink button-black" ! onclick "changeTab('heapchart', this)" $ "Heap"         when (isJust cc_descs) $ do           button ! class_ "tablink button-black" ! onclick "changeTab('cost-centres', this)" $ "Cost Centres"         when (isJust closure_descs) $ do           button ! class_ "tablink button-black" ! onclick "changeTab('closures', this)" $ "Detailed"-    let itd = if noTraces as then NoTraceData else TraceData     H.div ! class_ "row" $ do       H.div ! class_ "column" $ do+        let itd = if (noTraces as) then NoTraceData else TraceData         mapM_ (\(vid, chartname, conf) ->                   H.div ! A.id chartname ! class_ "tabviz" $ do-                    renderChart itd True vid+                    renderChart itd conf True vid                       (TL.toStrict (encodeToLazyText (vegaJson (htmlConf as conf)))))           [(1, "areachart",  AreaChart Stacked)           ,(2, "normalizedchart", AreaChart Normalized)           ,(3, "streamgraph", AreaChart StreamGraph)-          ,(4, "linechart", LineChart)]+          ,(4, "linechart", LineChart)+          ,(5, "heapchart", HeapChart) ]          when (isJust cc_descs) $ do           H.div ! A.id "cost-centres" ! class_ "tabviz" $ do-            renderChart itd False 5 treevega+            renderChart itd LineChart False 6 treevega         forM_ closure_descs $ \v -> do           H.div ! A.id "closures" ! class_ "tabviz" $ do             v     script $ preEscapedToHtml tablogic  +select_data :: IncludeTraceData -> ChartType -> [Text]+select_data itd c =+  case c of+    AreaChart {} -> prof_data+    LineChart {} -> prof_data+    HeapChart {} -> ["heap"] ++ ["traces" | TraceData <- [itd]]+  where+    prof_data =  ["samples"] ++ ["traces" | TraceData <- [itd]] ++ htmlConf :: Args -> ChartType -> ChartConfig-htmlConf as ct = ChartConfig 1200 1000 (not (noTraces as)) (userColourScheme as) ct (fromIntegral <$> (fixedYAxis as))+htmlConf as ct = ChartConfig 1200 1000 (not (noTraces as)) (userColourScheme as) "set1" ct (fromIntegral <$> (fixedYAxis as)) -renderChart :: IncludeTraceData -> Bool -> VizID -> Text -> Html-renderChart itd vega_lite vid vegaSpec = do+renderChart :: IncludeTraceData -> ChartType -> Bool -> VizID -> Text -> Html+renderChart itd ct vega_lite vid vegaSpec = do+    let fields = select_data itd ct     H.div ! A.id (fromString $ "vis" ++ show vid) ! class_ "chart" $ ""     script ! type_ "text/javascript" $ do       if vega_lite-        then encloseScript itd vid vegaSpec-        else encloseRawVegaScript itd vid vegaSpec+        then encloseScript fields vid vegaSpec+        else encloseRawVegaScript vid vegaSpec -renderChartWithJson :: IncludeTraceData -> Int -> Value -> Text -> Html-renderChartWithJson itd k dat vegaSpec = do+renderChartWithJson :: IncludeTraceData -> ChartType -> Int -> Value -> Text -> Html+renderChartWithJson itd ct k dat vegaSpec = do     script $ insertJsonData dat-    renderChart itd True k vegaSpec+    renderChart itd ct True k vegaSpec   templateString :: Header -> Value -> Maybe Value -> Maybe Html -> Args -> String@@ -201,4 +215,4 @@ ppHeapProfileType (HeapProfBreakdownRetainer) = "Retainer profiling (implied by -hr)" ppHeapProfileType (HeapProfBreakdownBiography) = "Biographical profiling (implied by -hb)" ppHeapProfileType (HeapProfBreakdownClosureType) = "Basic heap profile (implied by -hT)"---ppHeapProfileType (HeapProfBreakdownInfoTable) = "Info table profile (implied by -hi)"+ppHeapProfileType (HeapProfBreakdownInfoTable) = "Info table profile (implied by -hi)"

@@ -45,16 +45,24 @@  data Sample = Sample Bucket Double deriving Show +data HeapSample = HeapSample Double Word64 deriving Show+ data Frame = Frame Double [Sample] deriving Show  -- | A trace we also want to show on the graph data Trace = Trace Double Text deriving Show +data HeapInfo = HeapInfo { heapSizeSamples :: [HeapSample]+                         , blocksSizeSamples :: [HeapSample]+                         , liveBytesSamples :: [HeapSample]+                         } deriving Show+ data ProfData = ProfData { profHeader :: Header                          , profTotals :: (Map Bucket BucketInfo)                          , profCCMap  :: Map Word32 CostCentre                          , profFrames :: [Frame]                          , profTraces :: [Trace]+                         , profHeap   :: HeapInfo                          , profItl    :: Map InfoTablePtr InfoTableLoc } deriving Show  data InfoTableLoc = InfoTableLoc { itlName :: !Text

@@ -2,7 +2,9 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-module Eventlog.Vega (bandsToVega, tracesToVega) where+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RecordWildCards #-}+module Eventlog.Vega (bandsToVega, tracesToVega, heapToVega) where  import Data.Array.Base ((!), bounds) import Data.Array.Unboxed (UArray)@@ -12,6 +14,7 @@ import Eventlog.Types import Data.Aeson hiding (Series) import GHC.Generics+import Data.Word  data VegaEntry = VegaEntry { x :: Double, y :: Double, k :: Int, c :: Text }   deriving (Show, ToJSON, Generic)@@ -38,4 +41,13 @@  tracesToVega :: [Trace] -> [VegaTrace] tracesToVega = map (\(Trace t d) -> VegaTrace t d)++data VegaHeap = VegaHeap { x :: Double, y :: Word64, c :: Text, k :: Int}+  deriving (Show, ToJSON, Generic)++heapToVega :: HeapInfo -> [VegaHeap]+heapToVega HeapInfo{..} = mk 2 "Heap Size" heapSizeSamples ++ mk 0 "Live Bytes" liveBytesSamples ++ mk 1 "Blocks Size" blocksSizeSamples++  where+    mk k l xs = [VegaHeap t v l k | HeapSample t v <- xs] 

@@ -24,6 +24,7 @@ data ChartType   = AreaChart AreaChartType   | LineChart+  | HeapChart  -- Arguments for directly outputting javascript data ChartConfig =@@ -31,6 +32,7 @@               , cheight :: Double               , traces :: Bool               , colourScheme :: Text+              , lineColourScheme :: Text               , chartType :: ChartType               , fixedYAxisExtent :: Maybe Double               }@@ -38,6 +40,9 @@ colourProperty :: ChartConfig -> ScaleProperty colourProperty c = SScheme (colourScheme c) [] +lineColourProperty :: ChartConfig -> ScaleProperty+lineColourProperty c = SScheme (lineColourScheme c) []+ ----------------------------------------------------------------------------------- -- The visualization consists of: -- - AreaChart (on the left top)@@ -64,6 +69,7 @@     description "Heap Profile",     case chartType conf of       LineChart -> lineChartFull c'+      HeapChart -> heapChartFull c'       AreaChart ct -> areaChartFull ct c'   ] @@ -73,6 +79,9 @@ lineChartFull :: ChartConfig -> (VLProperty, VLSpec) lineChartFull c = vConcat [lineChart c, selectionChart c] +heapChartFull :: ChartConfig -> (VLProperty, VLSpec)+heapChartFull c = vConcat [heapChart c, selectionHeapChart c]+ config :: [ConfigureSpec] -> (VLProperty, VLSpec) config =   configure@@ -115,9 +124,47 @@   . filter (FSelection "legend")  -----------------------------------------------------------------------------------+-- The Heap Chart+-----------------------------------------------------------------------------------++heapChart :: ChartConfig -> VLSpec+heapChart c = asSpec [layer ([heapLayer c]  ++ [tracesLayer | traces c])]++heapLayer :: ChartConfig -> VLSpec+heapLayer c = asSpec+  [+    VL.width (0.9 * cwidth c),+    VL.height (0.7 * cheight c),+    dataFromSource "data_json_heap" [],+    VL.mark Line [MPoint (PMMarker [])],+    encodingHeapLayer c [],+    transformHeapLayer [],+    selectionRight []+  ]++transformHeapLayer :: [TransformSpec] -> (VLProperty, VLSpec)+transformHeapLayer =+  transform+  . filter (FSelection "legend")+++encodingHeapLayer :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)+encodingHeapLayer c+ = encoding+    . color [MName "c", MmType Nominal, MScale [lineColourProperty c]+            , MLegend [LNoTitle]]+    . position X [PName "x", PmType Quantitative, PAxis [AxTitle ""]+                 ,PScale [SDomainOpt (DSelection "brush")]]+    . position Y [PName "y", PmType Quantitative+                 , PAxis [AxTitle "Allocation", AxFormat "s"]+                 , PSort [ByFieldOp "k" Max]]+    . tooltip [TName "y", TmType Quantitative, TFormat "s" ]++----------------------------------------------------------------------------------- -- The Selection Chart ----------------------------------------------------------------------------------- + encodingSelection :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec) encodingSelection c =   encoding@@ -141,6 +188,30 @@     dataFromSource "data_json_samples" [],     VL.mark Area [],     encodingSelection c [],+    brush []+  ]++-----------------------------------------------------------------------------------+-- The Heap Selection Chart+-----------------------------------------------------------------------------------++encodingHeapSelection :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)+encodingHeapSelection c =+  encoding+    . tooltip []+    . color [MName "c", MmType Nominal, MScale [lineColourProperty c], MLegend [LValues (LStrings ["Heap Size", "Blocks Size", "Live Bytes"])]]+    . position X [PName "x", PmType Quantitative, PAxis [AxTitle "Time (s)"]]+    . position Y [PName "y", PmType Quantitative, PAxis [], PSort [ByFieldOp "k" Max]]++-- init field is not supported and necessary for dynamic loading++selectionHeapChart :: ChartConfig -> VLSpec+selectionHeapChart c = asSpec [+    VL.width (0.9 * cwidth c),+    VL.height (0.1 * cheight c),+    dataFromSource "data_json_heap" [],+    VL.mark Line [MPoint (PMMarker [])],+    encodingHeapSelection c [],     brush []   ]