packages feed

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 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