diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for hs-speedscope +## 0.2 -- 2020-03-21 + +* Add --start and --end options which allow a profile to be filtered by + eventlog UserMarker events + ## 0.1.1 -- 2019-11-07 * Relax eventlog version check to allow 8.9 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,3 +10,23 @@ 2. Run `hs-speedscope` on the resulting eventlog `hs-speedscope program.eventlog`. 3. Load the resulting `program.eventlog.json` file into [speedscope](https://speedscope.app) to visualise the profile. +## Filtering an eventlog + +It is sometimes useful to isolate a specific part of the sample, for example, when +I was profiling ghcide, I want to isolate a single hover request. + +The `--start` and `--end` options can be used to indicate which parts of the +eventlog to keep. The filtering options look for messages inserted into the +eventlog by [`traceMarker`](https://hackage.haskell.org/package/base-4.12.0.0/docs/Debug-Trace.html#v:traceMarker) events. + +* No events before the first marker which matches the prefix given by `--start` +will be included in the result +* No events after the first marker which matches the prefix given by `--end` will +be included in the result. + +For example, the following invocation will filter the profile between the START and END markers. + +``` +hs-speedscope File.eventlog --start START --end END +``` + diff --git a/hs-speedscope.cabal b/hs-speedscope.cabal --- a/hs-speedscope.cabal +++ b/hs-speedscope.cabal @@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: hs-speedscope -version: 0.1.1.0 +version: 0.2 synopsis: Convert an eventlog into the speedscope json format description: Convert an eventlog into the speedscope json format. The interactive visualisation displays an approximate trace of the program and summary views akin to .prof files. @@ -32,11 +32,12 @@ -- other-modules: -- other-extensions: build-depends: base >= 4.12.0.0 && < 5, - ghc-events >= 0.11, + ghc-events >= 0.11 && < 0.13, aeson >= 1.4, text >= 1.2, vector >= 0.12, extra >= 1.6, + optparse-applicative >= 0.15, hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/src/HsSpeedscope.hs b/src/HsSpeedscope.hs --- a/src/HsSpeedscope.hs +++ b/src/HsSpeedscope.hs @@ -4,12 +4,11 @@ import Data.Aeson -import GHC.RTS.Events +import GHC.RTS.Events hiding (header, str) import Data.Word import Data.Text (Text) import qualified Data.Vector.Unboxed as V -import System.Environment import Data.Maybe import Data.List.Extra import Control.Monad @@ -19,17 +18,69 @@ import Text.ParserCombinators.ReadP import qualified Paths_hs_speedscope as Paths +import Options.Applicative hiding (optional) +import qualified Options.Applicative as O +import Data.Semigroup ((<>)) + + +data SSOptions = SSOptions { file :: FilePath + , isolateStart :: Maybe String + , isolateEnd :: Maybe String + } deriving Show + + +optsParser :: Parser SSOptions +optsParser = SSOptions + <$> argument str (metavar "FILE.eventlog") + <*> O.optional (strOption + ( short 's' + <> long "start" + <> metavar "STRING" + <> help "No samples before the first eventlog message with this prefix will be included in the output" )) + <*> O.optional (strOption + ( short 'e' <> long "end" <> metavar "STRING" <> help "No samples after the first eventlog message with this prefix will be included in the output" )) + + + entry :: IO () entry = do - fps <- getArgs - case fps of - [fp] -> do - el <- either error id <$> readEventLogFromFile fp - encodeFile (fp ++ ".json") (convertToSpeedscope el) - _ -> error "Usage: hs-speedscope program.eventlog" + os <- execParser opts + run os + where + opts = info (optsParser <**> helper) + ( fullDesc + <> progDesc "Generate a speedscope.app json file from an eventlog" + <> header "hs-speedscope" ) -convertToSpeedscope :: EventLog -> Value -convertToSpeedscope (EventLog _h (Data es)) = +run :: SSOptions -> IO () +run os = do + el <- either error id <$> readEventLogFromFile (file os) + encodeFile (file os ++ ".json") (convertToSpeedscope (isolateStart os, isolateEnd os) el) + +data ReadState = + ReadAll -- Ignore all future + | IgnoreUntil String ReadState + | ReadUntil String ReadState + | IgnoreAll deriving Show + +shouldRead :: ReadState -> Bool +shouldRead ReadAll = True +shouldRead (ReadUntil {}) = True +shouldRead _ = False + +transition :: String -> ReadState -> ReadState +transition s r = case r of + (ReadUntil is n) | is `isPrefixOf` s -> n + (IgnoreUntil is n) | is `isPrefixOf` s -> n + _ -> r + +initState :: Maybe String -> Maybe String -> ReadState +initState Nothing Nothing = ReadAll +initState (Just s) e = IgnoreUntil s (initState Nothing e) +initState Nothing (Just e) = ReadUntil e IgnoreAll + +convertToSpeedscope :: (Maybe String, Maybe String) -> EventLog -> Value +convertToSpeedscope (is, ie) (EventLog _h (Data (sortOn evTime -> es))) = case el_version of Just (ghc_version, _) | ghc_version < makeVersion [8,9,0] -> error ("Eventlog is from ghc-" ++ showVersion ghc_version ++ " hs-speedscope only works with GHC 8.10 or later") @@ -43,7 +94,7 @@ ] where (EL (fromMaybe "" -> profile_name) el_version (fromMaybe 1 -> interval) frames samples) = - foldr processEvents initEL es + snd $ foldl' (flip processEvents) (initState is ie, initEL) es initEL = EL Nothing Nothing Nothing [] [] @@ -52,15 +103,17 @@ version_string = "hs-speedscope@" ++ showVersion Paths.version -- Drop 7 events for built in cost centres like GC, IDLE etc + ccs_raw = reverse (drop 7 (reverse frames)) + ccs_json :: [Value] - ccs_json = map mkFrame (reverse (drop 7 frames)) + ccs_json = map mkFrame ccs_raw num_frames = length ccs_json caps :: [(Capset, [[Int]])] - caps = groupSort $ mapMaybe mkSample samples + caps = groupSort $ mapMaybe mkSample (reverse samples) mkFrame :: CostCentre -> Value mkFrame (CostCentre _n l _m s) = object [ "name" .= l, "file" .= s ] @@ -68,18 +121,26 @@ mkSample :: Sample -> Maybe (Capset, [Int]) -- Filter out system frames mkSample (Sample _ti [k]) | fromIntegral k >= num_frames = Nothing - mkSample (Sample ti ccs) = Just (ti, reverse $ map (subtract 1 . fromIntegral) ccs) + mkSample (Sample ti ccs) = Just (ti, map (subtract 1 . fromIntegral) (reverse ccs)) - processEvents :: Event -> EL -> EL - processEvents (Event _t ei _c) el = + processEvents :: Event -> (ReadState, EL) -> (ReadState, EL) + processEvents (Event _t ei _c) (do_sample, el) = case ei of - ProgramArgs _ (pname: _args) -> el { prog_name = Just pname } - RtsIdentifier _ rts_ident -> el { rts_version = parseIdent rts_ident } - ProfBegin ival -> el { prof_interval = Just ival } - HeapProfCostCentre n l m s _ -> el { cost_centres = CostCentre n l m s : cost_centres el } - ProfSampleCostCentre t _ _ st -> el { el_samples = Sample t (V.toList st) : el_samples el } - _ -> el + ProgramArgs _ (pname: _args) -> + (do_sample, el { prog_name = Just pname }) + RtsIdentifier _ rts_ident -> + (do_sample, el { rts_version = parseIdent rts_ident }) + ProfBegin ival -> + (do_sample, el { prof_interval = Just ival }) + HeapProfCostCentre n l m s _ -> + (do_sample, el { cost_centres = CostCentre n l m s : cost_centres el }) + ProfSampleCostCentre t _ _ st -> + if shouldRead do_sample then + (do_sample, el { el_samples = Sample t (V.toList st) : el_samples el }) + else (do_sample, el) + (UserMarker m) -> (transition m do_sample, el) + _ -> (do_sample, el) mkProfile :: String -> Word64 -> (Capset, [[Int]]) -> Value mkProfile pname interval (_n, samples) = @@ -113,6 +174,6 @@ , el_samples :: [Sample] } -data CostCentre = CostCentre Word32 Text Text Text +data CostCentre = CostCentre Word32 Text Text Text deriving Show data Sample = Sample Capset [Word32]