├── .gitignore ├── .gitmodules ├── .travis.yml ├── LICENSE ├── ProfFile.hs ├── README.md ├── Setup.hs ├── ghc-prof-flamegraph.cabal ├── ghc-prof-flamegraph.hs └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "FlameGraph"] 2 | path = FlameGraph 3 | url = https://github.com/brendangregg/FlameGraph.git 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Travis script based on https://github.com/hvr/multi-ghc-travis 2 | 3 | env: 4 | - CABALVER=1.18 GHCVER=7.8.4 5 | - CABALVER=1.22 GHCVER=7.10.1 6 | 7 | before_install: 8 | - travis_retry sudo add-apt-repository -y ppa:hvr/ghc 9 | - travis_retry sudo apt-get update 10 | - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER 11 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH 12 | 13 | install: 14 | - cabal --version 15 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 16 | - travis_retry cabal update 17 | - cabal install --only-dependencies --enable-tests --enable-benchmarks 18 | 19 | script: 20 | - cabal configure -flib-Werror -v2 --enable-tests --enable-benchmarks 21 | - cabal build 22 | - cabal check 23 | - cabal sdist 24 | # check that the generated source-distribution can be built & installed 25 | - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; 26 | cd dist/; 27 | if [ -f "$SRC_TGZ" ]; then 28 | cabal install --force-reinstalls "$SRC_TGZ"; 29 | else 30 | echo "expected '$SRC_TGZ' not found"; 31 | exit 1; 32 | fi 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 FP Complete, http://www.fpcomplete.com/ 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /ProfFile.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | -- | Parser for .prof files generated by GHC. 3 | module ProfFile 4 | ( Time(..) 5 | , Line(..) 6 | , lIndividualTime 7 | , lInheritedTime 8 | , lIndividualAlloc 9 | , lInheritedAlloc 10 | , parse 11 | , processLines 12 | , findStart 13 | ) where 14 | 15 | import Control.Arrow (second, left) 16 | import Data.Char (isSpace) 17 | import Data.List (isPrefixOf) 18 | import Text.Read (readEither) 19 | import Control.Monad (unless) 20 | import Control.Applicative 21 | import Prelude -- Quash AMP related warnings in GHC>=7.10 22 | 23 | data Time = Time 24 | { tIndividual :: Double 25 | , tInherited :: Double 26 | } deriving (Show, Eq) 27 | 28 | data Line = Line 29 | { lCostCentre :: String 30 | , lModule :: String 31 | , lNumber :: Int 32 | , lEntries :: Int 33 | , lTime :: Time 34 | , lAlloc :: Time 35 | , lTicks :: Int 36 | , lBytes :: Int 37 | , lChildren :: [Line] 38 | } deriving (Show, Eq) 39 | 40 | lIndividualTime :: Line -> Double 41 | lIndividualTime = tIndividual . lTime 42 | 43 | lInheritedTime :: Line -> Double 44 | lInheritedTime = tInherited . lTime 45 | 46 | lIndividualAlloc :: Line -> Double 47 | lIndividualAlloc = tIndividual . lAlloc 48 | 49 | lInheritedAlloc :: Line -> Double 50 | lInheritedAlloc = tInherited . lAlloc 51 | 52 | data ProfFormat = NoSources | IncludesSources 53 | 54 | -- | Returns a function accepting the children and returning a fully 55 | -- formed 'Line'. 56 | parseLine :: ProfFormat -> String -> Either String ([Line] -> Line) 57 | parseLine format s = 58 | case format of 59 | NoSources -> 60 | case words s of 61 | (costCentre:module_:no:entries:indTime:indAlloc:inhTime:inhAlloc:other) -> 62 | parse' costCentre module_ no entries indTime indAlloc inhTime inhAlloc other 63 | _ -> Left $ "Malformed .prof file line:\n" ++ s 64 | IncludesSources -> 65 | case words s of 66 | (costCentre:module_:rest) | (no:entries:indTime:indAlloc:inhTime:inhAlloc:other) <- dropSRC rest -> 67 | parse' costCentre module_ no entries indTime indAlloc inhTime inhAlloc other 68 | _ -> Left $ "Malformed .prof file line:\n" ++ s 69 | where 70 | -- XXX: The SRC field can contain arbitrary characters (from the 71 | -- subdirectory name)! 72 | -- 73 | -- As a heuristic, assume SRC spans until the last word which: 74 | -- 75 | -- * Ends with '>' 76 | -- (for special values emitted by GHC like "") 77 | -- 78 | -- or 79 | -- 80 | -- * Contains a colon eventually followed by another colon or a minus 81 | -- (to identify the source span, e.g. ":69:55-64" or ":(36,1)-(38,30)", 82 | -- or maybe for a single character ":30:3") 83 | -- 84 | -- If there is no such word, assume SRC is just one word. 85 | -- 86 | -- This heuristic will break if: 87 | -- 88 | -- * In the future, columns to the right of SRC can match the above 89 | -- condition (currently, they're all numeric) 90 | -- 91 | -- or 92 | -- 93 | -- * GHC doesn't add a source span formatted as assumed above, and the 94 | -- SRC contains spaces 95 | -- 96 | -- The implementation is not very efficient, but I suppose this is not 97 | -- performance-critical. 98 | dropSRC (_:rest) = reverse . takeWhile (not . isPossibleEndOfSRC) . reverse $ rest 99 | dropSRC [] = [] 100 | 101 | isPossibleEndOfSRC w = last w == '>' 102 | || case break (==':') w of 103 | (_, _:rest) -> any (`elem` ":-") rest 104 | _ -> False 105 | 106 | parse' costCentre module_ no entries indTime indAlloc inhTime inhAlloc other = do 107 | pNo <- readEither' no 108 | pEntries <- readEither' entries 109 | pTime <- Time <$> readEither' indTime <*> readEither' inhTime 110 | pAlloc <- Time <$> readEither' indAlloc <*> readEither' inhAlloc 111 | (pTicks, pBytes) <- 112 | case other of 113 | (ticks:bytes:_) -> (,) <$> readEither' ticks <*> readEither' bytes 114 | _ -> pure (0, 0) 115 | return $ Line costCentre module_ pNo pEntries pTime pAlloc pTicks pBytes 116 | 117 | readEither' str = left (("Could not parse value "++show str++": ")++) 118 | (readEither str) 119 | 120 | type LineNumber = Int 121 | 122 | processLines :: ProfFormat -> [String] -> LineNumber -> Either String [Line] 123 | processLines format lines0 lineNumber0 = do 124 | ((ss,_), lines') <- go 0 lines0 lineNumber0 125 | unless (null ss) $ 126 | error "processLines: the impossible happened, not all strings were consumed." 127 | return lines' 128 | where 129 | go :: Int -> [String] -> LineNumber -> Either String (([String], LineNumber), [Line]) 130 | go _depth [] lineNumber = do 131 | return (([], lineNumber), []) 132 | go depth0 (line : lines') lineNumber = do 133 | let (spaces, rest) = break (not . isSpace) line 134 | let depth = length spaces 135 | if depth < depth0 136 | then return ((line : lines', lineNumber), []) 137 | else do 138 | parsedLine <- left (("Parse error in line "++show lineNumber++": ")++) $ 139 | parseLine format rest 140 | ((lines'', lineNumber''), children) <- go (depth + 1) lines' (lineNumber + 1) 141 | second (parsedLine children :) <$> go depth lines'' lineNumber'' 142 | 143 | firstLineNoSources :: [String] 144 | firstLineNoSources = ["COST", "CENTRE", "MODULE", "no.", "entries", "%time", "%alloc", "%time", "%alloc"] 145 | 146 | -- Since GHC 8.0.2 the cost centres include the src location 147 | firstLineIncludesSources :: [String] 148 | firstLineIncludesSources = ["COST", "CENTRE", "MODULE", "SRC", "no.", "entries", "%time", "%alloc", "%time", "%alloc"] 149 | 150 | findStart :: [String] -> LineNumber -> Either String (ProfFormat, [String], [String], LineNumber) 151 | findStart [] _ = Left "Malformed .prof file: couldn't find start line" 152 | findStart (line : _empty : lines') lineNumber | (firstLineNoSources `isPrefixOf` words line) = return (NoSources, words line, lines', lineNumber + 2) 153 | | (firstLineIncludesSources `isPrefixOf` words line) = return (IncludesSources, words line, lines', lineNumber + 2) 154 | findStart (_line : lines') lineNumber = findStart lines' (lineNumber + 1) 155 | 156 | parse :: String -> Either String ([String], [Line]) 157 | parse s = do 158 | (format, names, ss, lineNumber) <- findStart (lines s) 1 159 | return . (names,) =<< processLines format ss lineNumber 160 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ghc-prof-flamegraph 2 | 3 | [![Build Status](https://travis-ci.org/fpco/ghc-prof-flamegraph.svg)](https://travis-ci.org/fpco/ghc-prof-flamegraph) 4 | 5 | This is a small tool to convert GHC time profiling reports into a format 6 | understandable by the 7 | [FlameGraph](https://github.com/brendangregg/FlameGraph) tool. 8 | 9 | ## Install 10 | 11 | cabal install 12 | 13 | ## Usage 14 | 15 | First convert a `.prof` file into the flame graph svg: 16 | 17 | $ cat ~/src/packdeps/packdeps.prof | ghc-prof-flamegraph > packdeps.prof.svg 18 | 19 | Or, alternatively, just pass the `.prof` file as an argument. The tool will 20 | then create corresponing `.svg` file: 21 | 22 | $ ghc-prof-flamegraph ~/src/packdeps/packdeps.prof 23 | Output written to ~/src/packdeps/packdeps.svg 24 | 25 | The previous command will produce `~/src/packdeps/packdeps.svg` file. 26 | 27 | You can customize the behavior of the underlying `flamegraph.pl` by passing 28 | options via `–framegraph-option`. For example, you can customize the title: 29 | 30 | $ ghc-prof-flamegraph ~/src/packdeps/packdeps.prof '--flamegraph-option=--title=Package dependencies' 31 | Output written to ~/src/packdeps/packdeps.svg 32 | 33 | You can also generate a flamegraph using the allocation measurements, 34 | using the `--alloc` flag. 35 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ghc-prof-flamegraph.cabal: -------------------------------------------------------------------------------- 1 | name: ghc-prof-flamegraph 2 | version: 0.2.0.1 3 | synopsis: Generates flamegraphs from GHC .prof files. 4 | license: MIT 5 | license-file: LICENSE 6 | author: Francesco Mazzoli 7 | maintainer: francesco@fpcomplete.com 8 | copyright: (c) 2015 FP Complete Corporation 9 | category: Testing 10 | build-type: Simple 11 | cabal-version: >=1.10 12 | description: 13 | This is a small tool to render GHC time profiling reports as interactive SVG flame graphs 14 | using . Basic usage: 15 | . 16 | > ghc-prof-flamegraph myprogram.prof 17 | . 18 | You can also generate a flamegraph using the allocation measurements using the --alloc flag. 19 | . 20 | The flamegraph.pl script is bundled with this package, so you don't need to install it 21 | (though you need to have Perl installed). 22 | 23 | data-files: 24 | FlameGraph/flamegraph.pl 25 | 26 | source-repository head 27 | type: git 28 | location: https://github.com/fpco/ghc-prof-flamegraph 29 | 30 | executable ghc-prof-flamegraph 31 | main-is: ghc-prof-flamegraph.hs 32 | build-depends: base >=4.6 && <5 33 | , filepath 34 | , optparse-applicative 35 | , process 36 | other-modules: ProfFile 37 | , Paths_ghc_prof_flamegraph 38 | default-language: Haskell2010 39 | ghc-options: -Wall 40 | -------------------------------------------------------------------------------- /ghc-prof-flamegraph.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module Main (main) where 5 | 6 | import Control.Applicative ((<*>), (<|>), optional, many, pure) 7 | import Data.Foldable (traverse_) 8 | import Data.Functor ((<$>)) 9 | import Data.List (intercalate) 10 | import Data.Monoid ((<>)) 11 | import qualified Options.Applicative as Opts 12 | import qualified ProfFile as Prof 13 | import System.Exit (ExitCode(..), exitFailure) 14 | import System.FilePath ((), replaceExtension) 15 | import System.IO (stderr, stdout, hPutStrLn, hPutStr, hGetContents, IOMode(..), hClose, openFile) 16 | import System.Process (proc, createProcess, CreateProcess(..), StdStream(..), waitForProcess) 17 | 18 | import Paths_ghc_prof_flamegraph (getDataDir) 19 | 20 | data Options = Options 21 | { optionsReportType :: ReportType 22 | , optionsProfFile :: Maybe FilePath 23 | , optionsOutputFile :: Maybe FilePath 24 | , optionsFlamegraphFlags :: [String] 25 | } deriving (Eq, Show) 26 | 27 | data ReportType = Alloc -- ^ Report allocations, percent 28 | | Entries -- ^ Report entries, number 29 | | Time -- ^ Report time spent in closure, percent 30 | | Ticks -- ^ Report ticks, number 31 | | Bytes -- ^ Report bytes allocated, number 32 | deriving (Eq, Show) 33 | 34 | optionsParser :: Opts.Parser Options 35 | optionsParser = Options 36 | <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "Uses the allocation measurements instead of time measurements") 37 | <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "Uses entries the measurements instead of time measurements") 38 | <|> Opts.flag' Bytes (Opts.long "bytes" <> Opts.help "Memory measurements in bytes (+RTS -P -RTS)") 39 | <|> Opts.flag' Ticks (Opts.long "ticks" <> Opts.help "Time measurements in ticks (+RTS -P -RTS)") 40 | <|> Opts.flag Time Time (Opts.long "time" <> Opts.help "Uses time measurements")) 41 | <*> optional 42 | (Opts.strArgument 43 | (Opts.metavar "PROF-FILE" <> 44 | Opts.help "Profiling output to format as flame graph")) 45 | <*> optional 46 | (Opts.strOption 47 | (Opts.short 'o' <> 48 | Opts.long "output" <> 49 | Opts.metavar "SVG-FILE" <> 50 | Opts.help "Optional output file")) 51 | <*> many 52 | (Opts.strOption 53 | (Opts.long "flamegraph-option" <> 54 | Opts.metavar "STR" <> 55 | Opts.help "Options to pass to flamegraph.pl")) 56 | 57 | checkNames :: ReportType -> [String] -> Maybe String 58 | checkNames Alloc _ = Nothing 59 | checkNames Entries _ = Nothing 60 | checkNames Time _ = Nothing 61 | checkNames Ticks n 62 | | "ticks" `elem` n = Nothing 63 | | otherwise = Just "No ticks information, please run program with +RTS -P" 64 | checkNames Bytes n 65 | | "bytes" `elem` n = Nothing 66 | | otherwise = Just "No ticks information, please run program with +RTS -P" 67 | 68 | normalize :: ReportType -> Double -> Int 69 | normalize Alloc = round . (10 *) 70 | normalize Time = round . (10 *) 71 | normalize _ = round 72 | 73 | addUnknown :: ReportType -> (Int, [String]) -> [String] 74 | addUnknown Time = \(entries, frames) -> 75 | let unknown = 1000 - entries 76 | in if unknown > 0 77 | then ("UNKNOWN " ++ show unknown) : frames 78 | else frames 79 | addUnknown Alloc = \(entries, frames) -> 80 | let unknown = 1000 - entries 81 | in if unknown > 0 82 | then ("UNKNOWN " ++ show unknown) : frames 83 | else frames 84 | addUnknown _ = snd 85 | 86 | generateFrames :: Options -> [Prof.Line] -> [String] 87 | generateFrames options lines0 = addUnknown (optionsReportType options) $ go [] lines0 88 | where 89 | go :: [String] -> [Prof.Line] -> (Int, [String]) 90 | go _stack [] = 91 | (0, []) 92 | go stack (line : lines') = 93 | let entries = normalize (optionsReportType options) (individualMeasure line) 94 | symbol = Prof.lModule line ++ "." ++ Prof.lCostCentre line 95 | frame = intercalate ";" (reverse (symbol : stack)) ++ " " ++ show entries 96 | (childrenEntries, childrenFrames) = go (symbol : stack) (Prof.lChildren line) 97 | (restEntries, restFrames) = go stack lines' 98 | in (entries + childrenEntries + restEntries, frame : childrenFrames ++ restFrames) 99 | 100 | individualMeasure = case optionsReportType options of 101 | Alloc -> Prof.lIndividualAlloc 102 | Time -> Prof.lIndividualTime 103 | Entries -> fromIntegral . Prof.lEntries 104 | Ticks -> fromIntegral . Prof.lTicks 105 | Bytes -> fromIntegral . Prof.lBytes 106 | 107 | main :: IO () 108 | main = do 109 | options <- Opts.execParser $ 110 | Opts.info (Opts.helper <*> optionsParser) Opts.fullDesc 111 | s <- maybe getContents readFile $ optionsProfFile options 112 | case Prof.parse s of 113 | Left err -> error err 114 | Right (names, ls) -> 115 | case checkNames (optionsReportType options) names of 116 | Just problem -> do 117 | hPutStrLn stderr problem 118 | exitFailure 119 | Nothing -> do 120 | dataDir <- getDataDir 121 | let flamegraphPath = dataDir "FlameGraph" "flamegraph.pl" 122 | flamegraphProc = (proc "perl" (flamegraphPath : optionsFlamegraphFlags options)) 123 | { std_in = CreatePipe 124 | , std_out = CreatePipe 125 | , std_err = Inherit 126 | } 127 | (outputHandle, outputFileName, closeOutputHandle) <- 128 | case (optionsOutputFile options, optionsProfFile options) of 129 | (Just path, _) -> do 130 | h <- openFile path WriteMode 131 | pure (h, Just path, hClose h) 132 | (Nothing, Just path) -> do 133 | let path' = path `replaceExtension` "svg" 134 | h <- openFile path' WriteMode 135 | pure (h, Just path', hClose h) 136 | _ -> 137 | pure (stdout, Nothing, pure ()) 138 | (Just input, Just flamegraphResult, Nothing, procHandle) <- createProcess flamegraphProc 139 | traverse_ (hPutStrLn input) $ generateFrames options ls 140 | hClose input 141 | hGetContents flamegraphResult >>= hPutStr outputHandle 142 | exitCode <- waitForProcess procHandle 143 | closeOutputHandle 144 | case exitCode of 145 | ExitSuccess -> 146 | case outputFileName of 147 | Nothing -> pure () 148 | Just path -> putStrLn $ "Output written to " <> path 149 | ExitFailure{} -> 150 | hPutStrLn stderr $ "Call to flamegraph.pl at " <> flamegraphPath <> " failed" 151 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | resolver: lts-18.5 6 | --------------------------------------------------------------------------------