hs-speedscope (empty) → 0.1.0.0
raw patch · 7 files changed
+222/−0 lines, 7 filesdep +aesondep +basedep +extrasetup-changed
Dependencies added: aeson, base, extra, ghc-events, hs-speedscope, text, vector
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +12/−0
- Setup.hs +2/−0
- exe/Main.hs +6/−0
- hs-speedscope.cabal +50/−0
- src/HsSpeedscope.hs +117/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hs-speedscope++## 0.1 -- 2019-10-29++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Matthew Pickering++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Matthew Pickering nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,12 @@+# hs-speedscope++`hs-speedscope` is a simple executable for converting an eventlog into a format suitable to load into [speedscope](https://www.speedscope.app/).++WARNING: Only GHC 8.10 supports generating an eventlog with the correct events for this program to work.++## Usage++1. Create an eventlog which contains time profiling events by running your program with `program +RTS -p -l-au`.+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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ exe/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import HsSpeedscope++main :: IO ()+main = entry
+ hs-speedscope.cabal view
@@ -0,0 +1,50 @@+cabal-version: 2.4+-- Initial package description 'hs-speedscope.cabal' generated by 'cabal+-- init'. For further documentation, see+-- http://haskell.org/cabal/users-guide/++name: hs-speedscope+version: 0.1.0.0+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.+ There is also support for parallel programs, each capability is rendered in its own+ profile.+-- bug-reports:+license: BSD-3-Clause+license-file: LICENSE+author: Matthew Pickering+maintainer: matthewtpickering@gmail.com+-- copyright:+category: Development+tested-with: GHC==8.8.1+extra-source-files: CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/mpickering/hs-speedscope.git++library+ exposed-modules: HsSpeedscope+ other-modules: Paths_hs_speedscope+ autogen-modules: Paths_hs_speedscope+ -- other-modules:+ -- other-extensions:+ build-depends: base >= 4.12.0.0 && < 5,+ ghc-events >= 0.11,+ aeson >= 1.4,+ text >= 1.2,+ vector >= 0.12,+ extra >= 1.6,+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++executable hs-speedscope+ main-is: Main.hs+ -- other-modules:+ -- other-extensions:+ build-depends: base >=4.12.0.0 && < 5, hs-speedscope+ hs-source-dirs: exe+ default-language: Haskell2010
+ src/HsSpeedscope.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+module HsSpeedscope where+++import Data.Aeson+import GHC.RTS.Events++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+import Data.Char++import Data.Version+import Text.ParserCombinators.ReadP+import qualified Paths_hs_speedscope as Paths++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"++convertToSpeedscope :: EventLog -> Value+convertToSpeedscope (EventLog _h (Data 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")+ _ -> object [ "version" .= ("0.0.1" :: String)+ , "$schema" .= ("https://www.speedscope.app/file-format-schema.json" :: String)+ , "shared" .= object [ "frames" .= ccs_json ]+ , "profiles" .= map (mkProfile profile_name interval) caps+ , "name" .= profile_name+ , "activeProfileIndex" .= (0 :: Int)+ , "exporter" .= version_string+ ]+ where+ (EL (fromMaybe "" -> profile_name) el_version (fromMaybe 1 -> interval) frames samples) =+ foldr processEvents initEL es++ initEL = EL Nothing Nothing Nothing [] []++ version_string :: String+ version_string = "hs-speedscope@" ++ showVersion Paths.version++ -- Drop 7 events for built in cost centres like GC, IDLE etc++ ccs_json :: [Value]+ ccs_json = map mkFrame (reverse (drop 7 frames))++ num_frames = length ccs_json+++ caps :: [(Capset, [[Int]])]+ caps = groupSort $ mapMaybe mkSample samples++ mkFrame :: CostCentre -> Value+ mkFrame (CostCentre _n l _m s) = object [ "name" .= l, "file" .= s ]++ 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)+++ processEvents :: Event -> EL -> EL+ processEvents (Event _t ei _c) 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++mkProfile :: String -> Word64 -> (Capset, [[Int]]) -> Value+mkProfile pname interval (_n, samples) =+ object [ "type" .= ("sampled" :: String)+ , "unit" .= ("nanoseconds" :: String)+ , "name" .= pname+ , "startValue" .= (0 :: Int)+ , "endValue" .= (length samples :: Int)+ , "samples" .= samples+ , "weights" .= sample_weights ]+ where+ sample_weights :: [Word64]+ sample_weights = replicate (length samples) interval++parseIdent :: String -> Maybe (Version, String)+parseIdent s = listToMaybe $ flip readP_to_S s $ do+ void $ string "GHC-"+ [v1, v2, v3] <- replicateM 3 (intP <* optional (char '.'))+ skipSpaces+ return (makeVersion [v1,v2,v3])+ where+ intP = do+ x <- munch1 isDigit+ return $ read x++data EL = EL {+ prog_name :: Maybe String+ , rts_version :: Maybe (Version, String)+ , prof_interval :: Maybe Word64+ , cost_centres :: [CostCentre]+ , el_samples :: [Sample]+}++data CostCentre = CostCentre Word32 Text Text Text++data Sample = Sample Capset [Word32]