hs-speedscope 0.1.1.0 → 0.2

raw patch · 4 files changed

+112/−25 lines, 4 filesdep +optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +20/−0
• hs-speedscope.cabal +3/−2
• src/HsSpeedscope.hs +84/−23

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

@@ -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+```+

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

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