eventlog2html 0.3.0 → 0.4.0

raw patch · 10 files changed

+158/−103 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +11/−0
• eventlog2html.cabal +2/−2
• main/Main.hs +12/−7
• src/Eventlog/Args.hs +24/−7
• src/Eventlog/Data.hs +13/−21
• src/Eventlog/Events.hs +67/−33
• src/Eventlog/HeapProf.hs +2/−3
• src/Eventlog/Prune.hs +20/−19
• src/Eventlog/Total.hs +4/−11
• src/Eventlog/Types.hs +3/−0

@@ -1,3 +1,14 @@+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.+  "traceEvent" and "traceEventIO" are supposed to be used for high-frequency events.+  If you want to trace low-frequency events, especially in order to relate phases of your program to memory usage patterns,  use "traceMarker" and "traceMarkerIO" instead.+  If you want to return to the old behaviour, add the "--include-trace-events" option on the commandline.+* Removed "trace PERCENT" option, which had no effect in the code.+* Added warning about eventlogs with a lot of traces.+* Added option to filter the traces which should be included in the+  generated output.+ 0.3, released 2019-09-08  * Added warnings if eventlog2html is used on eventlogs generated by GHC Version without profiling support.

@@ -1,5 +1,5 @@ Name:                eventlog2html-Version:             0.3.0+Version:             0.4.0 Synopsis:            Visualise an eventlog Description:         eventlog2html is a library for visualising eventlogs.                      At the moment, the intended use is to visualise eventlogs@@ -31,7 +31,7 @@ cabal-version: 1.18 extra-doc-files: README.md                  CHANGELOG-Tested-With:         GHC ==8.6.4+Tested-With:         GHC ==8.6.5  Library   Build-depends:

@@ -6,17 +6,15 @@ import Data.Aeson (encodeFile, Value, toJSON) import System.FilePath import System.Exit+import System.IO -import Eventlog.Args (args, Args(..), Sort(..))+import Eventlog.Args (args, Args(..)) import Eventlog.Bands (bands)-import qualified Eventlog.Events as E-import qualified Eventlog.HeapProf as H import Eventlog.HtmlTemplate-import Eventlog.Prune (prune, cmpName, cmpSize, cmpStdDev)-import Eventlog.Total (total) import Eventlog.Data import Eventlog.Vega import Eventlog.VegaTemplate+import Eventlog.Types  main :: IO () main = do@@ -33,7 +31,7 @@      | otherwise -> doOneHtml a fin fout argsToOutput _ =   die "When the -o option is specified, exactly one eventlog file has to be passed."-  + doOneJson :: Args -> FilePath -> FilePath -> IO () doOneJson a fin fout = do   (_, val) <- generateJson fin a@@ -41,7 +39,14 @@  doOneHtml :: Args -> FilePath -> FilePath -> IO () doOneHtml a fin fout = do-  (header, data_json) <- generateJson fin a+  (header, data_json) <- generateJsonValidate checkTraces fin a   let html = templateString header data_json a   writeFile fout html+  where+    checkTraces :: ProfData -> IO ()+    checkTraces (ProfData _ _ _ ts) =+      if length ts > 1000+        then hPutStrLn stderr+              "More than 1000 traces, consider reducing using -i or -x"+        else return () 

@@ -18,13 +18,16 @@   {     sorting      :: Sort   , reversing    :: Bool-  , tracePercent :: Double   , nBands       :: Int   , heapProfile  :: Bool   , noIncludejs    :: Bool   , json         :: Bool   , noTraces     :: Bool+  , traceEvents  :: Bool -- ^ By default, only traceMarkers are included.+                         -- This option enables the inclusion of traceEvents.   , userColourScheme :: Text+  , includeStr :: [Text]+  , excludeStr :: [Text]   , outputFile :: Maybe String   , files        :: [String]   }@@ -40,12 +43,6 @@           ( long "reverse"          <> help "Reverse the order of bands." )       <*> option auto-          ( long "trace"-         <> help "Percentage of trace elements to combine."-         <> value 1-         <> showDefault-         <> metavar "PERCENT" )-      <*> option auto           ( long "bands"          <> help "Maximum number of bands to draw (0 for unlimited)."          <> value 15@@ -65,10 +62,30 @@       <*> switch           ( long "no-traces"           <> help "Don't display traces on chart")+      <*> switch+          ( long "include-trace-events"+          <> help ("Enables the inclusion of traces emitted using `traceEvent`"+                   ++ ", which should only be used for high-frequency events. "+                   ++ "For low frequency events, use `traceMarker` instead.")+          <> showDefault)       <*> option str           ( long "colour-scheme"           <> value "category20b"           <> help "The name of the colour scheme. See the vega documentation (https://vega.github.io/vega/docs/schemes/#reference) for a complete list. Examples include \"category10\" \"dark2\" \"tableau10\". ")+      <*> many (option str+          (short 'i'+          <> long "include"+          <> help ("Specify the traces which should be included in the output. Only traces which contain SUBSTRING "+                    ++ "in their name will be included. Multiple different traces can be included "+                    ++ "with \"-i foo -i bar\".")+          <> metavar "SUBSTRING"))+      <*> many (option str+          (short 'x'+          <> long "exclude"+          <> help ("Specify the traces which should be excluded in the output. All traces which contain SUBSTRING "+                    ++ "in their name will be excluded. Multiple different traces can be excluded "+                    ++ "with \"-x foo -x bar\".")+          <> metavar "SUBSTRING"))       <*> (optional $ option str           (short 'o'           <> help "Write the output to the given filename."

@@ -1,37 +1,29 @@ {-# LANGUAGE OverloadedStrings #-}-module Eventlog.Data (generateJson) where+module Eventlog.Data (generateJson, generateJsonValidate ) where  import Prelude hiding (print, readFile) import Data.Aeson (Value(..), (.=), object)-import Data.Tuple (swap) -import Eventlog.Args (Args(..), Sort(..))+import Eventlog.Args (Args(..)) import Eventlog.Bands (bands) import qualified Eventlog.Events as E import qualified Eventlog.HeapProf as H-import Eventlog.Prune (prune, cmpName, cmpSize, cmpStdDev)+import Eventlog.Prune (prune) import Eventlog.Vega-import Eventlog.Types (Header)+import Eventlog.Types (Header, ProfData(..)) -generateJson :: FilePath -> Args -> IO (Header, Value)-generateJson file a = do-  let chunk = if heapProfile a then H.chunk else E.chunk-      cmp = fst $ reversing' sorting'-      sorting' = case sorting a of-        Name -> cmpName-        Size -> cmpSize-        StdDev -> cmpStdDev-      reversing' = if reversing a then swap else id-  (h,totals, fs, traces) <- chunk file-  let keeps = prune cmp 0 (bound $ nBands a) totals-  let combinedJson = object [+generateJsonValidate :: (ProfData -> IO ()) -> FilePath -> Args -> IO (Header, Value)+generateJsonValidate validate file a = do+  let chunk = if heapProfile a then H.chunk else E.chunk a+  dat@(ProfData h totals fs traces) <- chunk file+  validate dat+  let keeps = prune a totals+      combinedJson = object [           "samples" .= bandsToVega keeps (bands h keeps fs)         , "traces"  .= tracesToVega traces         ]   return (h, combinedJson) -bound :: Int -> Int-bound n-  | n <= 0 = maxBound-  | otherwise = n+generateJson :: FilePath -> Args -> IO (Header, Value)+generateJson = generateJsonValidate (const (return ())) 

@@ -11,10 +11,10 @@ import Prelude hiding (init, lookup) import qualified Data.Text as T import Data.Text (Text)-import Data.Map (Map)  import Eventlog.Types import Eventlog.Total+import Eventlog.Args (Args(..)) import Data.List import Data.Function import Data.Word@@ -34,40 +34,40 @@ fromNano :: Word64 -> Double fromNano e = fromIntegral e * 1e-9 -chunk :: FilePath -> IO (Header,Map Text (Double, Double), [Frame], [Trace])-chunk f = do+chunk :: Args -> FilePath -> IO ProfData+chunk a f = do   (EventLog _ e) <- either error id <$> readEventLogFromFile f-  (ph, frames, traces) <- eventsToHP e+  (ph, frames, traces) <- eventsToHP a e   let (counts, totals) = total frames-  return $ (ph counts, totals, frames, traces)+  return $ (ProfData (ph counts) totals frames traces)  checkGHCVersion :: EL -> Maybe String checkGHCVersion EL { ident = Just (version,_)}   | version <= makeVersion [8,4,4]  =-      Just $ "Warning: The eventlog has been generated with GHC version "-           ++ show version+      Just $ "Warning: The eventlog has been generated with ghc-"+           ++ showVersion version            ++ ", which does not support profiling events in the eventlog." checkGHCVersion EL { pargs = Just args, ident = Just (version,_)}   | version > makeVersion [8,4,4] &&     version <= makeVersion [8,9,0] &&     ("-hr" `elem` args || "-hb" `elem` args) =-     Just $ "Warning: The eventlog has been generated with GHC version"-            ++ show version+     Just $ "Warning: The eventlog has been generated with ghc-"+            ++ showVersion version             ++ ", which does not support biographical or retainer profiling." checkGHCVersion _ = Nothing  -eventsToHP :: Data -> IO (PartialHeader, [Frame], [Trace])-eventsToHP (Data es) = do+eventsToHP :: Args -> Data -> IO (PartialHeader, [Frame], [Trace])+eventsToHP a (Data es) = do   let-      el@EL{..} = foldEvents es+      el@EL{..} = foldEvents a es       fir = Frame (fromNano start) []       las = Frame (fromNano end) []   mapM_ (hPutStrLn stderr) (checkGHCVersion el)   return $ (elHeader el, fir : reverse (las: normalise frames) , traces) -normalise :: [(Word64, [Sample])] -> [Frame]-normalise fs = map (\(t, ss) -> Frame (fromNano t) ss) fs+normalise :: [FrameEL] -> [Frame]+normalise fs = map (\(FrameEL t ss) -> Frame (fromNano t) ss) fs   data EL = EL@@ -75,12 +75,14 @@   , ident :: Maybe (Version, String)   , ccMap :: !(Map.Map Word32 CostCentre)   , clocktimeSec :: !Word64-  , samples :: !(Maybe (Word64, [Sample]))-  , frames :: ![(Word64, [Sample])]+  , samples :: !(Maybe FrameEL)+  , frames :: ![FrameEL]   , traces :: ![Trace]   , start :: !Word64   , end :: !Word64 } deriving Show +data FrameEL = FrameEL Word64 [Sample] deriving Show+ data CostCentre = CC { cid :: Word32                      , label :: Text                      , modul :: Text@@ -99,27 +101,33 @@   , ccMap = Map.empty   } -foldEvents :: [Event] -> EL-foldEvents (e:es) =-  let res = foldl' folder  (initEL (evTime e)) (e:es)+foldEvents :: Args -> [Event] -> EL+foldEvents a (e:es) =+  let res = foldl' (folder a)  (initEL (evTime e)) (e:es)   in addFrame 0 res-foldEvents [] = error "Empty event log"+foldEvents _ [] = error "Empty event log" -folder :: EL -> Event -> EL-folder el (Event t e _) = el &+folder :: Args -> EL -> Event -> EL+folder a el (Event t e _) = el &   updateLast t .     case e of       -- Traces+      -- Messages and UserMessages correspond to high-frequency "traceEvent" or "traceEventIO" events from Debug.Trace and+      -- are only included if "--include-trace-events" has been specified.+      -- For low-frequency events "traceMarker" or "traceMarkerIO" should be used, which generate "UserMarker" events.+      Message s -> if traceEvents a then addTrace a (Trace (fromNano t) (T.pack s)) else id+      UserMessage s -> if traceEvents a then addTrace a (Trace (fromNano t) (T.pack s)) else id+      UserMarker s -> addTrace a (Trace (fromNano t) (T.pack s))+      -- Information about the program       RtsIdentifier _ ident -> addIdent ident-      Message s -> addTrace (Trace (fromNano t) (T.pack s))-      UserMessage s -> addTrace (Trace (fromNano t) (T.pack s))+      ProgramArgs _ as -> addArgs as+      WallClockTime _ s _ -> addClocktime s+      -- Profiling Events       HeapProfBegin {} -> addFrame t       HeapProfCostCentre cid l m loc _  -> addCostCentre cid (CC cid l m loc)       HeapProfSampleBegin {} -> addFrame t       HeapProfSampleCostCentre _hid r d s -> addCCSample r d s       HeapProfSampleString _hid res k -> addSample (Sample k (fromIntegral res))-      ProgramArgs _ as -> addArgs as-      WallClockTime _ s _ -> addClocktime s       _ -> id  addIdent :: String -> EL -> EL@@ -155,23 +163,49 @@ addArgs :: [String] -> EL -> EL addArgs as el = el { pargs = Just as } -addTrace :: Trace -> EL -> EL-addTrace t el = el { traces = t : traces el } +-- | Decide whether to include a trace based on the "includes" and+-- "excludes" options.+--+-- If a trace satisfies an `-i` flag then it is certainly included.+--+-- For example for a trace called "eventlog2html" then `-i eventlog -x+-- html` will still include the trace because the `-i` option matches.+--+-- If a trace doesn't match an `-i` flag then it is excluded if it matches+-- a `-x` flag.+--+filterTrace :: [Text] -> [Text] -> Trace -> Bool+filterTrace []       []       _             = True+filterTrace []       excludes (Trace _ trc) =+  not (any (flip T.isInfixOf trc) excludes)+filterTrace includes []       (Trace _ trc) =+  any (flip T.isInfixOf trc) includes+filterTrace includes excludes (Trace _ trc) =+  any (flip T.isInfixOf trc) includes+    || not (any (flip T.isInfixOf trc) excludes)++addTrace :: Args -> Trace -> EL -> EL+addTrace a t el | noTraces a = el+                | prop t     = el { traces = t : traces el }+                | otherwise  = el+  where+    prop = filterTrace (includeStr a) (excludeStr a)+ addFrame :: Word64 -> EL -> EL addFrame t el =-  el { samples = Just (t, [])+  el { samples = Just (FrameEL t [])      , frames = sampleToFrames (samples el) (frames el) } -sampleToFrames :: Maybe (Word64, [Sample]) -> [(Word64, [Sample])]-                                           -> [(Word64, [Sample])]-sampleToFrames (Just (t, ss)) fs = (t, (reverse ss)) : fs+sampleToFrames :: Maybe FrameEL -> [FrameEL]+                                -> [FrameEL]+sampleToFrames (Just (FrameEL t ss)) fs = FrameEL t (reverse ss) : fs sampleToFrames Nothing fs = fs  addSample :: Sample -> EL -> EL addSample s el = el { samples = go <$> (samples el) }   where-    go (t, ss) = (t, (s:ss))+    go (FrameEL t ss) = FrameEL t (s:ss)  updateLast :: Word64 -> EL -> EL updateLast t el = el { end = t }

@@ -5,17 +5,16 @@ import Data.Text (Text, lines, init, drop, length, isPrefixOf, unpack, words, pack) import Data.Text.IO (readFile) import Data.Attoparsec.Text (parseOnly, double)-import Data.Map (Map)  import Eventlog.Total import Eventlog.Types -chunk :: FilePath -> IO (Header, Map Text (Double, Double), [Frame], [Trace])+chunk :: FilePath -> IO ProfData chunk f = do   (ph, fs) <- chunkT <$> readFile f   let (counts, totals) = total fs   -- Heap profiles do not support traces-  return (ph counts, totals, fs, [])+  return (ProfData (ph counts) totals fs [])  chunkT :: Text -> (Int -> Header, [Frame]) chunkT s =

@@ -1,23 +1,23 @@ module Eventlog.Prune   ( prune-  , Compare-  , cmpName-  , cmpSize-  , cmpStdDev   ) where  import Data.Text (Text)-import Data.List (foldl', sortBy)+import Data.List (sortBy) import Data.Ord (comparing) import Data.Map.Strict (Map, toList, fromList) +import Eventlog.Args (Args(..), Sort(..))+ type Compare a = a -> a -> Ordering -cmpName, cmpSize, cmpStdDev-  :: (Compare (Text, (Double, Double)), Compare (Text, (Double, Double)))-cmpName = (cmpNameAscending, cmpNameDescending)-cmpSize = (cmpSizeDescending, cmpSizeAscending)-cmpStdDev = (cmpStdDevDescending, cmpStdDevAscending)+getComparison :: Args -> Compare (Text, (Double, Double))+getComparison Args { sorting = Size,   reversing = False }  = cmpSizeDescending+getComparison Args { sorting = Size,   reversing = True } = cmpSizeAscending+getComparison Args { sorting = StdDev, reversing = False }  = cmpStdDevDescending+getComparison Args { sorting = StdDev, reversing = True } = cmpStdDevAscending+getComparison Args { sorting = Name,   reversing = True }  = cmpNameDescending+getComparison Args { sorting = Name,   reversing = False } = cmpNameAscending  cmpNameAscending, cmpNameDescending,   cmpStdDevAscending, cmpStdDevDescending,@@ -29,17 +29,18 @@ cmpSizeAscending = comparing (fst . snd) cmpSizeDescending = flip cmpSizeAscending -prune :: Compare (Text, (Double, Double)) -> Double -> Int -> Map Text (Double, Double) -> Map Text Int-prune cmp tracePercent nBands ts =+prune :: Args -> Map Text (Double, Double) -> Map Text Int+prune args ts =   let ccTotals = sortBy cmpSizeDescending (toList ts)       sizes = map (fst . snd) ccTotals-      total = sum' sizes-      limit = if tracePercent == 0 then total-                                   else (1 - tracePercent / 100) * total+      limit = sum sizes       bigs = takeWhile (< limit) . scanl (+) 0 $ sizes-      bands = zipWith const ccTotals $ take nBands bigs-      ccs = map fst (sortBy cmp bands)+      bands = zipWith const ccTotals $ take (bound $ nBands args) bigs+      ccs = map fst (sortBy (getComparison args) bands)   in  fromList (reverse ccs `zip` [1 ..]) -sum' :: [Double] -> Double-sum' = foldl' (+) 0+bound :: Int -> Int+bound n+  | n <= 0 = maxBound+  | otherwise = n+

@@ -2,7 +2,7 @@ module Eventlog.Total (total) where  import Control.Monad.State.Strict (State(), execState, get, put, modify)-import Data.Map (Map, empty, lookup, insert, alter)+import Data.Map (Map, empty, alter) import Prelude hiding (init, lookup, lines, words, drop, length, readFile) import Data.Text (Text) @@ -11,13 +11,12 @@  data Parse =   Parse-  { symbols   :: !(Map Text Text) -- intern symbols to save RAM-  , totals    :: !(Map Text (Double, Double)) -- compute running totass and total of squares+  { totals    :: !(Map Text (Double, Double)) -- compute running totass and total of squares   , count     :: !Int                         -- number of frames   }  parse0 :: Parse-parse0 = Parse{ symbols = empty, totals = empty, count = 0 }+parse0 = Parse{ totals = empty, count = 0 }  total :: [Frame] -> (Int, Map Text (Double, Double)) total fs =@@ -39,13 +38,7 @@ inserter :: Sample -> State Parse Double inserter (Sample k v) = do   p <- get-  k' <- case lookup k (symbols p) of-    Nothing -> do-      put $! p{ symbols = insert k k (symbols p) }-      return k-    Just kk -> return kk-  p' <- get-  put $! p'{ totals = alter (accum  v) k' (totals p') }+  put $! p { totals = alter (accum  v) k (totals p) }   return $! v  accum :: Double -> Maybe (Double, Double) -> Maybe (Double, Double)

@@ -1,6 +1,7 @@ module Eventlog.Types where  import Data.Text (Text)+import Data.Map (Map)  data Header =   Header@@ -17,3 +18,5 @@  -- | 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]