├── .gitignore ├── doc └── blogpost │ ├── nouser.script │ ├── .gitignore │ └── Makefile ├── Setup.hs ├── cabal.haskell-ci ├── cabal.project ├── slicedfinely.png ├── slicedcoarsely.png ├── cabal.project.ci ├── examples ├── Examples │ ├── Common.hs │ ├── Ex0.hs │ ├── Ex1.hs │ └── Ex0_Windowed.hs └── BlogpostExamples.hs ├── src └── GHC │ └── RTS │ └── Events │ ├── Analyze │ ├── Script │ │ └── Standard.hs │ ├── StrictState.hs │ ├── Utils.hs │ ├── Reports │ │ ├── Totals.hs │ │ ├── Timed.hs │ │ └── Timed │ │ │ └── SVG.hs │ ├── Options.hs │ ├── Types.hs │ ├── Script.hs │ └── Analysis.hs │ └── Analyze.hs ├── LICENSE ├── ChangeLog ├── README.md ├── ghc-events-analyze.cabal └── .github └── workflows └── haskell-ci.yml /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle/ 2 | .envrc 3 | -------------------------------------------------------------------------------- /doc/blogpost/nouser.script: -------------------------------------------------------------------------------- 1 | GC 2 | all thread 3 | -------------------------------------------------------------------------------- /doc/blogpost/.gitignore: -------------------------------------------------------------------------------- 1 | *.svg 2 | *.eventlog 3 | *.txt 4 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | copy-fields: all 3 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | package ghc-events-analyze 4 | tests: true 5 | -------------------------------------------------------------------------------- /slicedfinely.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/well-typed/ghc-events-analyze/HEAD/slicedfinely.png -------------------------------------------------------------------------------- /slicedcoarsely.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/well-typed/ghc-events-analyze/HEAD/slicedcoarsely.png -------------------------------------------------------------------------------- /cabal.project.ci: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | package ghc-events-analyze 4 | tests: true 5 | ghc-options: -Werror 6 | -------------------------------------------------------------------------------- /examples/Examples/Common.hs: -------------------------------------------------------------------------------- 1 | module Examples.Common ( 2 | fib 3 | , printFib 4 | , blips 5 | ) where 6 | 7 | import Control.Concurrent (threadDelay) 8 | 9 | -- Intentionally slow fib 10 | fib :: Integer -> Integer 11 | fib 0 = 1 12 | fib 1 = 1 13 | fib n = fib (n - 1) + fib (n - 2) 14 | 15 | printFib :: Integer -> IO () 16 | printFib n = print (fib n) 17 | 18 | blips :: IO () 19 | blips = do 20 | putStrLn "BLIP" 21 | threadDelay 5000000 22 | putStrLn "BLIP" 23 | 24 | -------------------------------------------------------------------------------- /examples/Examples/Ex0.hs: -------------------------------------------------------------------------------- 1 | module Examples.Ex0 (main) where 2 | 3 | import Control.Concurrent (threadDelay) 4 | import Control.Concurrent.Async (async, wait) 5 | 6 | import Examples.Common 7 | 8 | main :: IO () 9 | main = do 10 | -- To generate a picture similar to the one in the blog post, the entire test 11 | -- should take roughly 30 seconds. Tweak arguments to 'fib' accordingly. 12 | a1 <- async $ mapM_ printFib [30, 32 .. 42] 13 | a2 <- async $ mapM_ printFib [31, 33 .. 43] 14 | threadDelay 5000000 15 | a3 <- async $ blips 16 | mapM_ wait [a1, a2, a3] 17 | -------------------------------------------------------------------------------- /examples/BlogpostExamples.hs: -------------------------------------------------------------------------------- 1 | module BlogpostExamples (main) where 2 | 3 | import System.Environment 4 | 5 | import Examples.Ex0 qualified as Ex0 6 | import Examples.Ex0_Windowed qualified as Ex0_Windowed 7 | import Examples.Ex1 qualified as Ex1 8 | 9 | main :: IO () 10 | main = do 11 | args <- getArgs 12 | case args of 13 | [] -> return () -- For use by @cabal test@ 14 | ["ex0"] -> Ex0.main 15 | ["ex0-windowed"] -> Ex0_Windowed.main 16 | ["ex1"] -> Ex1.main 17 | _otherwise -> error $ "Invalid arguments " ++ show args -------------------------------------------------------------------------------- /src/GHC/RTS/Events/Analyze/Script/Standard.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | module GHC.RTS.Events.Analyze.Script.Standard ( 3 | defaultScriptTotals 4 | , defaultScriptTimed 5 | ) where 6 | 7 | import GHC.RTS.Events.Analyze.Script 8 | 9 | defaultScriptTotals :: Script String 10 | defaultScriptTotals = [scriptQQ| 11 | GC 12 | 13 | section "USER EVENTS (user events are corrected for GC)" 14 | all user by total 15 | sum user 16 | 17 | section "THREAD EVENTS" 18 | all thread by name 19 | sum thread 20 | |] 21 | 22 | defaultScriptTimed :: Script String 23 | defaultScriptTimed = [scriptQQ| 24 | GC 25 | 26 | section "USER EVENTS" 27 | all user by name 28 | 29 | section "THREAD EVENTS" 30 | all thread by name 31 | |] 32 | -------------------------------------------------------------------------------- /examples/Examples/Ex1.hs: -------------------------------------------------------------------------------- 1 | module Examples.Ex1 (main) where 2 | 3 | import Control.Concurrent (myThreadId, threadDelay) 4 | import Control.Concurrent.Async (Async, async, wait) 5 | import Control.Exception (bracket_) 6 | import Debug.Trace (traceEventIO) 7 | import GHC.Conc (labelThread) 8 | 9 | import Examples.Common 10 | 11 | event :: String -> IO a -> IO a 12 | event label = 13 | bracket_ (traceEventIO $ "START " ++ label) 14 | (traceEventIO $ "STOP " ++ label) 15 | 16 | async' :: String -> IO a -> IO (Async a) 17 | async' label act = async $ do 18 | tid <- myThreadId 19 | labelThread tid label 20 | act 21 | 22 | printFib' :: Integer -> IO () 23 | printFib' n = event ("fib" ++ show n) $ printFib n 24 | 25 | main :: IO () 26 | main = do 27 | -- See 'Ex0' on how to tweak the parameters to 'fib' 28 | a1 <- async' "evens" $ mapM_ printFib' [30, 32 .. 42] 29 | a2 <- async' "odds" $ mapM_ printFib' [31, 33 .. 43] 30 | threadDelay 5000000 31 | a3 <- async' "blips" $ blips 32 | mapM_ wait [a1, a2, a3] 33 | -------------------------------------------------------------------------------- /examples/Examples/Ex0_Windowed.hs: -------------------------------------------------------------------------------- 1 | module Examples.Ex0_Windowed (main) where 2 | 3 | import Control.Concurrent (threadDelay) 4 | import Control.Concurrent.Async (async, wait) 5 | import Debug.Trace (traceEventIO) 6 | 7 | import Examples.Common 8 | 9 | main :: IO () 10 | main = do 11 | -- See 'Ex0' on how to tweak the parameters to 'fib' 12 | 13 | traceEventIO "START WINDOW" 14 | do a1 <- async $ mapM_ printFib [30, 32 .. 42] 15 | a2 <- async $ mapM_ printFib [31, 33 .. 43] 16 | threadDelay 5000000 17 | ax <- async $ blips 18 | mapM_ wait [a1, a2, ax] 19 | traceEventIO "STOP WINDOW" 20 | 21 | traceEventIO "START WINDOW" 22 | do a1 <- async $ mapM_ printFib [29, 32 .. 41] 23 | a2 <- async $ mapM_ printFib [30, 33 .. 42] 24 | a3 <- async $ mapM_ printFib [31, 34 .. 43] 25 | threadDelay 5000000 26 | ax <- async $ blips 27 | mapM_ wait [a1, a2, a3, ax] 28 | traceEventIO "STOP WINDOW" 29 | 30 | traceEventIO "START WINDOW" 31 | do a1 <- async $ mapM_ printFib [28, 32 .. 40] 32 | a2 <- async $ mapM_ printFib [29, 33 .. 41] 33 | a3 <- async $ mapM_ printFib [30, 34 .. 42] 34 | a4 <- async $ mapM_ printFib [31, 35 .. 43] 35 | threadDelay 5000000 36 | ax <- async $ blips 37 | mapM_ wait [a1, a2, a3, a4, ax] 38 | traceEventIO "STOP WINDOW" 39 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2025 Well-Typed LLP 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Edsko de Vries nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /doc/blogpost/Makefile: -------------------------------------------------------------------------------- 1 | # Blogpost examples 2 | # 3 | # See . 4 | 5 | .PHONY: svgs 6 | svgs: eventlogs 7 | # Examples from the blog post, in order. 8 | cabal run -- ghc-events-analyze -b 50 --script-timed nouser.script ex0-NT.eventlog 9 | cabal run -- ghc-events-analyze -b 50 ex1-NT.eventlog 10 | cabal run -- ghc-events-analyze -b 50 ex1-N1.eventlog 11 | cabal run -- ghc-events-analyze -b 50 ex1-N2.eventlog 12 | # Window example (https://github.com/well-typed/ghc-events-analyze/pull/11) 13 | cabal run -- ghc-events-analyze -b 50 --script-timed nouser.script --window "WINDOW" ex0-windowed-NT.eventlog 14 | 15 | .PHONY: eventlogs 16 | eventlogs: \ 17 | ex0-NT.eventlog \ 18 | ex1-NT.eventlog \ 19 | ex1-N1.eventlog \ 20 | ex1-N2.eventlog \ 21 | ex0-windowed-NT.eventlog 22 | 23 | ex0-NT.eventlog: 24 | cabal run -- blogpost-examples-nt ex0 +RTS -l 25 | mv blogpost-examples-nt.eventlog ex0-NT.eventlog 26 | 27 | ex1-NT.eventlog: 28 | cabal run -- blogpost-examples-nt ex1 +RTS -l 29 | mv blogpost-examples-nt.eventlog ex1-NT.eventlog 30 | 31 | ex1-N1.eventlog: 32 | cabal run -- blogpost-examples-threaded ex1 +RTS -l -N1 33 | mv blogpost-examples-threaded.eventlog ex1-N1.eventlog 34 | 35 | ex1-N2.eventlog: 36 | cabal run -- blogpost-examples-threaded ex1 +RTS -l -N2 37 | mv blogpost-examples-threaded.eventlog ex1-N2.eventlog 38 | 39 | ex0-windowed-NT.eventlog: 40 | cabal run -- blogpost-examples-nt ex0-windowed +RTS -l 41 | mv blogpost-examples-nt.eventlog ex0-windowed-NT.eventlog 42 | 43 | .PHONY: clean 44 | clean: 45 | rm -f *.eventlog *.svg 46 | rm -f *.totals.txt *.timed.txt 47 | 48 | # vi:set noexpandtab: 49 | -------------------------------------------------------------------------------- /src/GHC/RTS/Events/Analyze/StrictState.hs: -------------------------------------------------------------------------------- 1 | -- | State monad which forces the state to whnf on every step 2 | module GHC.RTS.Events.Analyze.StrictState ( 3 | -- * Transformer 4 | StateT 5 | , runStateT 6 | , evalStateT 7 | , execStateT 8 | -- * Base monad 9 | , State 10 | , runState 11 | , evalState 12 | , execState 13 | , modify 14 | -- * Re-exports 15 | , module Control.Monad.State.Strict 16 | ) where 17 | 18 | import Control.Monad.Identity (Identity(..)) 19 | import Control.Monad.IO.Class (MonadIO) 20 | import Control.Monad.State.Strict (MonadState(..)) 21 | import Control.Monad.State.Strict qualified as St 22 | import Control.Monad.Trans.Class (MonadTrans) 23 | 24 | {------------------------------------------------------------------------------- 25 | Transformer 26 | -------------------------------------------------------------------------------} 27 | 28 | newtype StateT s m a = StateT { unStateT :: St.StateT s m a } 29 | deriving newtype (Functor, Applicative, Monad, MonadTrans, MonadIO) 30 | 31 | runStateT :: StateT s m a -> s -> m (a, s) 32 | runStateT = St.runStateT . unStateT 33 | 34 | evalStateT :: Monad m => StateT s m a -> s -> m a 35 | evalStateT = St.evalStateT . unStateT 36 | 37 | execStateT :: Monad m => StateT s m a -> s -> m s 38 | execStateT = St.execStateT . unStateT 39 | 40 | instance Monad m => MonadState s (StateT s m) where 41 | get = StateT get 42 | put s = s `seq` StateT (put s) 43 | 44 | {------------------------------------------------------------------------------- 45 | Base monad 46 | -------------------------------------------------------------------------------} 47 | 48 | type State s a = StateT s Identity a 49 | 50 | runState :: State s a -> s -> (a, s) 51 | runState act = runIdentity . runStateT act 52 | 53 | evalState :: State s a -> s -> a 54 | evalState act = runIdentity . evalStateT act 55 | 56 | execState :: State s a -> s -> s 57 | execState act = runIdentity . execStateT act 58 | 59 | modify :: (s -> s) -> State s () 60 | modify = StateT . St.modify' 61 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 0.2.9 2 | 3 | * Support `ghc-9.6.5` and `SVGFonts-1.8` 4 | (2025-07-19 Vladimir Ovechkin ) 5 | * Drop support for `ghc < 9.2`, general cleanup. 6 | 7 | 0.2.8 8 | 9 | * Support for ghc-events-0.13 10 | (2020-04-23 Mitsutoshi Aoe ) 11 | 12 | 0.2.7 13 | 14 | * Support for GHC 8.8 15 | (2019-12-10 Simon Jakobi ) 16 | 17 | 0.2.6 18 | 19 | * Support for GHC 8.6 20 | (2019-11-01 Simon Jakobi ) 21 | 22 | 0.2.5 23 | 24 | * Add support for filtering threads by name, and improve 25 | performance of relabelling. 26 | (2017-03-11 Pepe Iborra ) 27 | 28 | 0.2.4 29 | 30 | * Fix bug in timeline rendering when using --tick-every 31 | (2016-10-04 Edsko de Vries ) 32 | * Backwards compatibility with older ghc 33 | 34 | 0.2.3 35 | 36 | * Add new command line options: `--tick-every`, `--bucket-width`, 37 | `--bucket-height`, and `--border-width`. This allows to get both the 38 | behaviour we used in the blogpost and the behaviour that was implemented 39 | by Andrew Farmer in 0.2.1 40 | (2016-10-03 Edsko de Vries ) 41 | * Fix issue with thread creation before window start 42 | (2015-09-29, Will Sewell ) 43 | * Bump optparse-applicative and lens versions 44 | (2015-01-19, Will Sewell ) 45 | 46 | 0.2.2 47 | 48 | * Adds support for GHC 7.10 49 | (2015-09-23, Will Sewell ) 50 | (2015-05-29, GaneshRapolu ) 51 | 52 | 0.2.1 53 | 54 | * Various new features: slice time more finely, add sorting options for timed 55 | report, more colours, support for ms on the timeline, use alternating 56 | colours for background, support for windowing. 57 | (2014-12-06, Andrew Farmer ) 58 | * Make sure _shutdown is always set, so that event logs from programs 59 | that terminated abnormally can still be visualized 60 | (2014-03-14, Bas van Dijk ) 61 | * Relax bounds 62 | (2014-05-28, Dominic Steinitz ) 63 | (2014-11-05, Alexander Vershilov ) 64 | (2014-11-07, Andrew Farmer ) 65 | * Move to diagrams 1.2 66 | (2014-06-25, Carter Tazio Schonwald ) 67 | * Fix space leak in recordShutdown 68 | (2014-08-15, John Lato ) 69 | 70 | 0.2.0 71 | 72 | * Initial release 73 | (2014-02-12, Edsko de Vries ) 74 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ghc-events-analyze 2 | ================== 3 | 4 | See [Performance profiling with 5 | ghc-events-analyze](http://www.well-typed.com/blog/2014/02/ghc-events-analyze/) 6 | for an introduction to this tool. Below we describe some features that were 7 | introduced since the blog post. 8 | 9 | ## Controlling layout 10 | 11 | As of version 0.2.3, there are a number of options for controlling the layout. 12 | To slice time coarsely, as we did in the blog post, you can run 13 | 14 | ``` 15 | ghc-events-analyze -b 50 ... 16 | ``` 17 | 18 | This results in something like 19 | 20 | ![](slicedcoarsely.png) 21 | 22 | By default (in 0.2.0 and again from 0.2.3) time is split into 100 buckets. To 23 | slice time more finely (this was the default for versions 0.2.1 and 0.2.2), you 24 | can run 25 | 26 | ``` 27 | ghc-events-analyze -b 500 --tick-every 10 --bucket-width 1 --border-width 0 28 | ``` 29 | 30 | The results in something like 31 | 32 | ![](slicedfinely.png) 33 | 34 | ## Windowing 35 | 36 | Windowing can be used to split all events into a bunch of reports, one per 37 | window. You can use it like this: 38 | 39 | ``` 40 | traceEventIO "START WINDOW" 41 | ... 42 | traceEventIO "STOP WINDOW" 43 | 44 | traceEventIO "START WINDOW" 45 | ... 46 | traceEventIO "STOP WINDOW" 47 | 48 | traceEventIO "START WINDOW" 49 | ... 50 | traceEventIO "STOP WINDOW" 51 | ``` 52 | 53 | If you then run `ghc-events-analyze` using `--window "WINDOW"` it will create 54 | one report per window; for instance, in the above example it would create 55 | 56 | ``` 57 | example.0.timed.svg 58 | example.1.timed.svg 59 | example.2.timed.svg 60 | ``` 61 | 62 | ## Event subscripts 63 | 64 | Suppose you have multiple events that should all show up as `request` in the 65 | generated reports, but should nonetheless be distinguished from each other. 66 | There are two ways to do this. One is to call the events `request0`, `request1`, 67 | etc. 68 | 69 | ``` 70 | traceEventIO "START request0" 71 | ... 72 | traceEventIO "STOP request0" 73 | 74 | traceEventIO "START request1" 75 | ... 76 | traceEventIO "STOP request1" 77 | ``` 78 | 79 | and then use the `ghc-events-analyze` DSL to add some renaming instructions. 80 | However, that might get tedious if there are a lof of these. Alternatively, 81 | you can use event subscripts, like this: 82 | 83 | ``` 84 | traceEventIO "START 0 request" 85 | ... 86 | traceEventIO "STOP 0 request" 87 | 88 | traceEventIO "START 1 request" 89 | ... 90 | traceEventIO "STOP 1 request" 91 | ``` 92 | 93 | These subscripts are used to distinguish events, but do not show up in the 94 | report. 95 | -------------------------------------------------------------------------------- /src/GHC/RTS/Events/Analyze.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Monad (when, forM_) 4 | import Data.List.NonEmpty qualified as NonEmpty 5 | import Data.Maybe (isNothing) 6 | import System.FilePath (replaceExtension, takeFileName) 7 | import Text.Parsec.String (parseFromFile) 8 | 9 | import GHC.RTS.Events.Analyze.Analysis 10 | import GHC.RTS.Events.Analyze.Options 11 | import GHC.RTS.Events.Analyze.Reports.Timed qualified as Timed 12 | import GHC.RTS.Events.Analyze.Reports.Timed.SVG qualified as TimedSVG 13 | import GHC.RTS.Events.Analyze.Reports.Totals qualified as Totals 14 | import GHC.RTS.Events.Analyze.Script 15 | import GHC.RTS.Events.Analyze.Script.Standard 16 | 17 | main :: IO () 18 | main = do 19 | options@Options{..} <- parseOptions 20 | analyses <- analyze options <$> readEventLog optionsInput 21 | 22 | (timedScriptName, timedScript) <- getScript optionsScriptTimed defaultScriptTimed 23 | (totalsScriptName, totalsScript) <- getScript optionsScriptTotals defaultScriptTotals 24 | 25 | let writeReport :: Bool 26 | -> String 27 | -> String 28 | -> (FilePath -> IO ()) 29 | -> IO () 30 | writeReport isEnabled 31 | scriptName 32 | newExt 33 | mkReport = when isEnabled $ do 34 | let output = replaceExtension (takeFileName optionsInput) newExt 35 | mkReport output 36 | putStrLn $ "Generated " ++ output ++ " using " ++ scriptName 37 | 38 | prefixAnalysisNumber :: Int -> String -> String 39 | prefixAnalysisNumber i filename 40 | | isNothing optionsWindowEvent = filename 41 | | otherwise = show i ++ "." ++ filename 42 | 43 | forM_ (zip [0..] (NonEmpty.toList analyses)) $ \ (i,analysis) -> do 44 | 45 | let quantized = quantize optionsNumBuckets analysis 46 | totals = Totals.createReport analysis totalsScript 47 | timed = Timed.createReport analysis quantized timedScript 48 | 49 | writeReport optionsGenerateTotalsText 50 | totalsScriptName 51 | (prefixAnalysisNumber i "totals.txt") 52 | (Totals.writeReport totals) 53 | 54 | writeReport optionsGenerateTimedSVG 55 | timedScriptName 56 | (prefixAnalysisNumber i "timed.svg") 57 | (TimedSVG.writeReport options quantized timed) 58 | 59 | writeReport optionsGenerateTimedText 60 | timedScriptName 61 | (prefixAnalysisNumber i "timed.txt") 62 | (Timed.writeReport timed) 63 | 64 | getScript :: FilePath -> Script String -> IO (String, Script String) 65 | getScript "" def = return ("default script", def) 66 | getScript path _ = do 67 | mScript <- parseFromFile pScript path 68 | case mScript of 69 | Left err -> fail (show err) 70 | Right script -> return (path, script) 71 | -------------------------------------------------------------------------------- /src/GHC/RTS/Events/Analyze/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module GHC.RTS.Events.Analyze.Utils ( 3 | throwLeft 4 | , throwLeftStr 5 | , insertWith 6 | , explode 7 | , mapEithers 8 | , unsparse 9 | , Alignment(..) 10 | , renderTable 11 | , showThreadId 12 | ) where 13 | 14 | import Control.Exception 15 | import Control.Lens 16 | import Data.Either (partitionEithers) 17 | import Data.List (transpose) 18 | import Data.Text (Text) 19 | import Data.Text qualified as T 20 | import GHC.RTS.Events (ThreadId) 21 | 22 | throwLeft :: Exception e => IO (Either e a) -> IO a 23 | throwLeft act = act >>= \ea -> case ea of Left e -> throwIO e 24 | Right a -> return a 25 | 26 | throwLeftStr :: IO (Either String a) -> IO a 27 | throwLeftStr = throwLeft . fmap (either (Left . userError) Right) 28 | 29 | -- | Like `Map.insertWith`, but for associative lists 30 | -- 31 | -- > updateAssocs f key val [.. (key, val') ..] == [.. (key, val' `f` val) ..] 32 | -- > updateAssocs f key val assocs == assocs ++ [(key, val)] 33 | insertWith :: Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)] 34 | insertWith f key val = go 35 | where 36 | go [] = [(key, val)] 37 | go ((key', val') : assocs) 38 | | key == key' = (key, val' `f` val) : assocs 39 | | otherwise = (key', val') : go assocs 40 | 41 | -- | Like PHP's explode function 42 | -- 43 | -- > explode ',' "abc,def,ghi" == ["abc","def","ghi"] 44 | explode :: Eq a => a -> [a] -> [[a]] 45 | explode needle = go 46 | where 47 | go xs = case break (== needle) xs of 48 | (before, []) -> [before] 49 | (before, _ : after) -> before : go after 50 | 51 | mapEithers :: forall a b c d. 52 | ([a] -> [c]) 53 | -> ([b] -> [d]) 54 | -> [Either a b] 55 | -> [Either c d] 56 | mapEithers f g eithers = rebuild eithers (f lefts) (g rights) 57 | where 58 | (lefts, rights) = partitionEithers eithers 59 | 60 | rebuild :: [Either a b] -> [c] -> [d] -> [Either c d] 61 | rebuild [] [] [] = [] 62 | rebuild (Left _ : es) (x : xs) ys = Left x : rebuild es xs ys 63 | rebuild (Right _ : es) xs (y : ys) = Right y : rebuild es xs ys 64 | rebuild _ _ _ = error "mapEithers: lengths changed" 65 | 66 | -- | Turn a sparse representation of a list into a regular list, using 67 | -- a default value for the blanks 68 | {-# INLINE unsparse #-} 69 | unsparse :: FoldableWithIndex Int f => t -> f t -> [t] 70 | unsparse blank = go 0 . itoList 71 | where 72 | --go :: Int -> [(Int, a)] -> [a] 73 | go _ [] = [] 74 | go n ((m, a) : as) = replicate (m - n) blank ++ a : go (m + 1) as 75 | 76 | -- | Alignment options for `renderTable` 77 | data Alignment = AlignLeft | AlignRight 78 | 79 | -- | "Typeset" a table 80 | renderTable :: [Alignment] -> [[Text]] -> [[Text]] 81 | renderTable aligns rows = transpose paddedColumns 82 | where 83 | columns :: [[Text]] 84 | columns = transpose rows 85 | 86 | columnWidths :: [Int] 87 | columnWidths = map (maximum . map T.length) columns 88 | 89 | paddedColumns :: [[Text]] 90 | paddedColumns = map padColumn (zip3 aligns columnWidths columns) 91 | 92 | padColumn :: (Alignment, Int, [Text]) -> [Text] 93 | padColumn (align, width, column) = map (padCell align width) column 94 | 95 | padCell :: Alignment -> Int -> Text -> Text 96 | padCell align width cell = 97 | let padding = T.replicate (width - T.length cell) " " 98 | in case align of 99 | AlignLeft -> cell <> padding 100 | AlignRight -> padding <> cell 101 | 102 | showThreadId :: ThreadId -> Text 103 | showThreadId = T.pack . show 104 | -------------------------------------------------------------------------------- /src/GHC/RTS/Events/Analyze/Reports/Totals.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module GHC.RTS.Events.Analyze.Reports.Totals ( 3 | Report 4 | , ReportFragment(..) 5 | , ReportLine(..) 6 | , createReport 7 | , writeReport 8 | ) where 9 | 10 | import Control.Lens hiding (filtered) 11 | import Data.Function (on) 12 | import Data.List (sortBy, group) 13 | import Data.Text (Text) 14 | import Data.Text qualified as T 15 | import Data.Text.IO qualified as T 16 | import GHC.RTS.Events (Timestamp) 17 | import System.IO (Handle, withFile, IOMode(WriteMode)) 18 | import Text.Printf (printf) 19 | 20 | import GHC.RTS.Events.Analyze.Analysis 21 | import GHC.RTS.Events.Analyze.Types 22 | import GHC.RTS.Events.Analyze.Script 23 | import GHC.RTS.Events.Analyze.Utils 24 | 25 | {------------------------------------------------------------------------------- 26 | Types 27 | -------------------------------------------------------------------------------} 28 | 29 | type Report = [ReportFragment] 30 | 31 | data ReportFragment = 32 | ReportSection Title 33 | | ReportLine ReportLine 34 | deriving Show 35 | 36 | data ReportLine = ReportLineData { 37 | lineHeader :: Text 38 | , lineEventIds :: [EventId] 39 | , lineTotal :: Timestamp 40 | } 41 | deriving Show 42 | 43 | {------------------------------------------------------------------------------- 44 | Report generation 45 | -------------------------------------------------------------------------------} 46 | 47 | createReport :: EventAnalysis -> Script String -> Report 48 | createReport analysis@EventAnalysis{..} = concatMap go . fmap (fmap (mkThreadFilter _windowThreadInfo)) 49 | where 50 | go :: Command (ThreadId -> Bool) -> [ReportFragment] 51 | go (Section title) = 52 | [ReportSection title] 53 | go (One eid title) = 54 | [ReportLine $ reportLine title (eid, totalForEvent eid)] 55 | go (All f sort) = 56 | map (ReportLine . reportLine Nothing) (sorted sort $ filtered f) 57 | go (Sum f title) = 58 | [ReportLine $ sumLines title $ map (reportLine Nothing) (filtered f)] 59 | 60 | flattenedThreadInfo = over (each._3) flattenThreadLabels _windowThreadInfo 61 | flattenThreadLabels = T.intercalate ":" . map head . group 62 | 63 | reportLine :: Maybe Title -> (EventId, Timestamp) -> ReportLine 64 | reportLine title (eid, total) = ReportLineData { 65 | lineHeader = showTitle (showEventId flattenedThreadInfo eid) title 66 | , lineEventIds = [eid] 67 | , lineTotal = total 68 | } 69 | 70 | totalForEvent :: EventId -> Timestamp 71 | totalForEvent = eventTotal analysis 72 | 73 | sorted :: Maybe EventSort -> [(EventId, a)] -> [(EventId, a)] 74 | sorted Nothing = id 75 | sorted (Just sort) = sortBy (compareEventIds analysis sort `on` fst) 76 | 77 | filtered :: EventFilter (ThreadId -> Bool) -> [(EventId, Timestamp)] 78 | filtered f = filter (matchesFilter f . fst) (itoList eventTotals) 79 | 80 | sumLines :: Maybe Title -> [ReportLine] -> ReportLine 81 | sumLines title qs = ReportLineData { 82 | lineHeader = showTitle "TOTAL" title 83 | , lineEventIds = concatMap lineEventIds qs 84 | , lineTotal = foldr (+) 0 $ map lineTotal qs 85 | } 86 | 87 | showTitle :: Text -> Maybe Title -> Text 88 | showTitle _ (Just title) = title 89 | showTitle def Nothing = def 90 | 91 | {------------------------------------------------------------------------------- 92 | Write report in textual form 93 | -------------------------------------------------------------------------------} 94 | 95 | writeReport :: Report -> FilePath -> IO () 96 | writeReport report path = withFile path WriteMode $ writeReport' report 97 | 98 | writeReport' :: Report -> Handle -> IO () 99 | writeReport' report h = 100 | mapM_ writeLine 101 | $ mapEithers id (renderTable (AlignLeft : repeat AlignRight)) 102 | $ map reportFragment report 103 | where 104 | writeLine :: Either Title [Text] -> IO () 105 | writeLine (Left header) = T.hPutStrLn h $ "\n" <> header 106 | writeLine (Right cells) = T.hPutStrLn h $ T.intercalate " " cells 107 | 108 | reportFragment :: ReportFragment -> Either Title [Text] 109 | reportFragment (ReportSection title) = Left title 110 | reportFragment (ReportLine line) = Right (reportLine line) 111 | 112 | reportLine :: ReportLine -> [Text] 113 | reportLine ReportLineData{..} = 114 | [ lineHeader 115 | , T.pack $ printf "%dns" $ lineTotal 116 | , T.pack $ printf "%0.3fs" $ toSec lineTotal 117 | ] 118 | 119 | toSec :: Timestamp -> Double 120 | toSec = (/ 1000000000) . fromInteger . toInteger 121 | -------------------------------------------------------------------------------- /ghc-events-analyze.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: ghc-events-analyze 3 | version: 0.2.9 4 | synopsis: Analyze and visualize event logs 5 | description: ghc-events-analyze is a simple Haskell profiling tool that 6 | uses GHC's eventlog system. It helps with some profiling 7 | use cases that are not covered by the existing GHC 8 | profiling modes or tools. It has two major features: 9 | . 10 | 1. While ThreadScope shows CPU activity across all your 11 | cores, ghc-events-analyze shows CPU activity across all 12 | your Haskell threads. 13 | . 14 | 2. It lets you label periods of time during program 15 | execution (by instrumenting your code with special trace 16 | calls) and then lets you visualize those time periods or 17 | get statistics on them. 18 | . 19 | It is very useful for profiling code when ghc's normal 20 | profiling mode is not available, or when using profiling 21 | mode would perturb the code too much. It is also useful 22 | when you want time-profiling information with a breakdown 23 | over time rather than totals for the whole run. 24 | . 25 | The blog post 26 | 27 | describes the motivation in more detail. 28 | license: BSD-3-Clause 29 | license-file: LICENSE 30 | author: Edsko de Vries, Duncan Coutts, Mikolaj Konarski 31 | maintainer: edsko@well-typed.com 32 | copyright: 2013-2025 Well-Typed LLP 33 | category: Development, Profiling, Trace 34 | build-type: Simple 35 | extra-doc-files: ChangeLog 36 | tested-with: GHC==9.2.8 37 | GHC==9.4.8 38 | GHC==9.6.7 39 | GHC==9.8.4 40 | GHC==9.10.2 41 | GHC==9.12.2 42 | 43 | 44 | source-repository head 45 | type: git 46 | location: https://github.com/edsko/ghc-events-analyze 47 | 48 | common lang 49 | default-language: GHC2021 50 | build-depends: base >= 4.16 && < 4.22 51 | 52 | ghc-options: 53 | -Wall 54 | -Wredundant-constraints 55 | -Wunused-packages 56 | -Wprepositive-qualified-module 57 | -rtsopts 58 | 59 | default-extensions: 60 | DeriveAnyClass 61 | DerivingStrategies 62 | RecordWildCards 63 | ViewPatterns 64 | 65 | if impl(ghc >= 9.8) 66 | ghc-options: -Wno-x-partial 67 | 68 | executable ghc-events-analyze 69 | import: lang 70 | hs-source-dirs: src 71 | main-is: GHC/RTS/Events/Analyze.hs 72 | 73 | other-modules: 74 | GHC.RTS.Events.Analyze.Analysis 75 | GHC.RTS.Events.Analyze.Options 76 | GHC.RTS.Events.Analyze.Reports.Timed 77 | GHC.RTS.Events.Analyze.Reports.Timed.SVG 78 | GHC.RTS.Events.Analyze.Reports.Totals 79 | GHC.RTS.Events.Analyze.Script 80 | GHC.RTS.Events.Analyze.Script.Standard 81 | GHC.RTS.Events.Analyze.StrictState 82 | GHC.RTS.Events.Analyze.Types 83 | GHC.RTS.Events.Analyze.Utils 84 | 85 | build-depends: 86 | -- bundled libraries 87 | , containers >= 0.6 && < 0.8 88 | , filepath >= 1.4 && < 1.6 89 | , mtl >= 2.2 && < 2.4 90 | , parsec >= 3.1 && < 3.2 91 | , template-haskell >= 2.18 && < 2.24 92 | , text >= 1.2 && < 2.2 93 | , transformers >= 0.5 && < 0.7 94 | 95 | build-depends: 96 | -- other external dependencies 97 | , diagrams-lib >= 1.5 && < 1.6 98 | , diagrams-svg >= 1.5 && < 1.6 99 | , ghc-events >= 0.20 && < 0.21 100 | , hashable >= 1.4 && < 1.6 101 | , lens >= 5.3 && < 5.4 102 | , optparse-applicative >= 0.19 && < 0.20 103 | , regex-pcre-builtin >= 0.95 && < 0.96 104 | , SVGFonts >= 1.8 && < 1.9 105 | , th-lift >= 0.8 && < 0.9 106 | , th-lift-instances >= 0.1 && < 0.2 107 | , unordered-containers >= 0.2 && < 0.3 108 | 109 | other-extensions: 110 | TemplateHaskell 111 | QuasiQuotes 112 | 113 | common blogpost-examples 114 | import: lang 115 | ghc-options: -main-is BlogpostExamples 116 | hs-source-dirs: examples 117 | 118 | other-modules: 119 | Examples.Common 120 | Examples.Ex0 121 | Examples.Ex0_Windowed 122 | Examples.Ex1 123 | 124 | build-depends: 125 | , async >= 2.2 && < 2.3 126 | 127 | test-suite blogpost-examples-nt 128 | import: blogpost-examples 129 | main-is: BlogpostExamples.hs 130 | type: exitcode-stdio-1.0 131 | 132 | test-suite blogpost-examples-threaded 133 | import: blogpost-examples 134 | type: exitcode-stdio-1.0 135 | main-is: BlogpostExamples.hs 136 | ghc-options: -threaded 137 | -------------------------------------------------------------------------------- /src/GHC/RTS/Events/Analyze/Reports/Timed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module GHC.RTS.Events.Analyze.Reports.Timed ( 3 | Report 4 | , ReportFragment(..) 5 | , ReportLine(..) 6 | , createReport 7 | , writeReport 8 | ) where 9 | 10 | import Control.Lens (itoList, (^.), over, each, _3) 11 | import Data.Function (on) 12 | import Data.HashMap.Strict qualified as Map 13 | import Data.IntMap.Strict (IntMap) 14 | import Data.IntMap.Strict qualified as IntMap 15 | import Data.List (group, sortBy) 16 | import Data.Text (Text) 17 | import Data.Text qualified as T 18 | import Data.Text.IO qualified as T 19 | import System.IO (Handle, withFile, IOMode(WriteMode)) 20 | import Text.Printf (printf) 21 | 22 | import GHC.RTS.Events.Analyze.Analysis 23 | import GHC.RTS.Events.Analyze.Script 24 | import GHC.RTS.Events.Analyze.Types 25 | import GHC.RTS.Events.Analyze.Utils 26 | 27 | {------------------------------------------------------------------------------- 28 | Types 29 | -------------------------------------------------------------------------------} 30 | 31 | type Report = [ReportFragment] 32 | 33 | data ReportFragment = 34 | ReportSection Title 35 | | ReportLine ReportLine 36 | deriving Show 37 | 38 | data ReportLine = ReportLineData { 39 | lineHeader :: Text 40 | , lineEventIds :: [EventId] 41 | , lineBackground :: Maybe (Int, Int) 42 | , lineValues :: IntMap Double 43 | } 44 | deriving Show 45 | 46 | {------------------------------------------------------------------------------- 47 | Report generation 48 | -------------------------------------------------------------------------------} 49 | 50 | createReport :: EventAnalysis -> Quantized -> Script String -> Report 51 | createReport analysis Quantized{..} = concatMap go . fmap (fmap (mkThreadFilter (analysis^.windowThreadInfo))) 52 | where 53 | go :: Command (ThreadId -> Bool)-> [ReportFragment] 54 | go (Section title) = 55 | [ReportSection title] 56 | go (One eid title) = 57 | [ReportLine $ reportLine title (eid, quantTimesForEvent eid)] 58 | go (All f sort) = 59 | map (ReportLine . reportLine Nothing) (sorted sort $ filtered f) 60 | go (Sum f title) = 61 | [ReportLine $ sumLines title $ map (reportLine Nothing) (filtered f)] 62 | 63 | quantThreadInfoFlattened = over (each._3) flattenThreadLabels quantThreadInfo 64 | flattenThreadLabels = T.intercalate ":" . map head . group 65 | 66 | reportLine :: Maybe Title -> (EventId, IntMap Double) -> ReportLine 67 | reportLine title (eid, qs) = ReportLineData { 68 | lineHeader = showTitle (showEventId quantThreadInfoFlattened eid) title 69 | , lineEventIds = [eid] 70 | , lineBackground = background eid 71 | , lineValues = qs 72 | } 73 | 74 | -- For threads we draw a background showing the thread's lifetime 75 | background :: EventId -> Maybe (Int, Int) 76 | background EventGC = Nothing 77 | background (EventUser _ _) = Nothing 78 | background (EventThread tid) = 79 | case Map.lookup tid quantThreadInfo of 80 | Just (start, stop, _) -> Just (start, stop) 81 | Nothing -> error $ "Invalid thread ID " ++ show tid 82 | 83 | quantTimesForEvent :: EventId -> IntMap Double 84 | quantTimesForEvent eid = 85 | case Map.lookup eid quantTimes of 86 | Nothing -> mempty -- this event didn't happen in the window 87 | Just times -> times 88 | 89 | sorted :: Maybe EventSort -> [(EventId, a)] -> [(EventId, a)] 90 | sorted Nothing = id 91 | sorted (Just sort) = sortBy (compareEventIds analysis sort `on` fst) 92 | 93 | filtered :: EventFilter (ThreadId -> Bool) -> [(EventId, IntMap Double)] 94 | filtered f = filter (matchesFilter f . fst) (itoList quantTimes) 95 | 96 | sumLines :: Maybe Title -> [ReportLine] -> ReportLine 97 | sumLines title qs = ReportLineData { 98 | lineHeader = showTitle "TOTAL" title 99 | , lineEventIds = concatMap lineEventIds qs 100 | , lineBackground = foldr1 combineBG $ map lineBackground qs 101 | , lineValues = IntMap.unionsWith (+) $ map lineValues qs 102 | } 103 | where 104 | combineBG :: Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int) 105 | combineBG (Just (fr, to)) (Just (fr', to')) = Just (min fr fr', max to to') 106 | combineBG _ _ = Nothing 107 | 108 | showTitle :: a -> Maybe a -> a 109 | showTitle _ (Just title) = title 110 | showTitle def Nothing = def 111 | 112 | {------------------------------------------------------------------------------- 113 | Write the report in textual form 114 | -------------------------------------------------------------------------------} 115 | 116 | writeReport :: Report -> FilePath -> IO () 117 | writeReport report path = withFile path WriteMode $ writeReport' report 118 | 119 | writeReport' :: Report -> Handle -> IO () 120 | writeReport' report h = 121 | mapM_ writeLine 122 | $ mapEithers id (renderTable (AlignLeft : repeat AlignRight)) 123 | $ map reportFragment report 124 | where 125 | writeLine :: Either Text [Text] -> IO () 126 | writeLine (Left header) = T.hPutStrLn h $ "\n" <> header 127 | writeLine (Right cells) = T.hPutStrLn h $ T.intercalate " " cells 128 | 129 | reportFragment :: ReportFragment -> Either Text [Text] 130 | reportFragment (ReportSection title) = Left title 131 | reportFragment (ReportLine line) = Right (reportLine line) 132 | 133 | reportLine :: ReportLine -> [Text] 134 | reportLine ReportLineData{..} = 135 | lineHeader : unsparse "0.00" (over each showValue lineValues) 136 | 137 | showValue :: Double -> Text 138 | showValue = T.pack . printf "%0.2f" 139 | -------------------------------------------------------------------------------- /src/GHC/RTS/Events/Analyze/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module GHC.RTS.Events.Analyze.Options ( 4 | Options(..) 5 | , parseOptions 6 | ) where 7 | 8 | import Options.Applicative 9 | 10 | import GHC.RTS.Events.Analyze.Types 11 | import GHC.RTS.Events.Analyze.Script 12 | import GHC.RTS.Events.Analyze.Script.Standard 13 | 14 | parseOptions :: IO Options 15 | parseOptions = customExecParser (prefs showHelpOnError) opts 16 | where 17 | opts = info (helper <*> parserOptions) $ mconcat [ 18 | fullDesc 19 | , progDesc "Quantize and visualize EVENTLOG" 20 | , footer "If no output is selected, generates SVG and totals." 21 | ] 22 | 23 | parserOptions :: Parser Options 24 | parserOptions = 25 | (infoOption scriptHelp $ mconcat [ 26 | long "help-script" 27 | , help "Detailed information about scripts" 28 | ]) 29 | <*> (selectDefaultOutput <$> (Options 30 | <$> (switch $ mconcat [ 31 | long "timed" 32 | , help "Generate timed report (in SVG format)" 33 | ]) 34 | <*> (switch $ mconcat [ 35 | long "timed-txt" 36 | , help "Generate timed report (in textual format)" 37 | ]) 38 | <*> (switch $ mconcat [ 39 | long "totals" 40 | , help "Generate totals report" 41 | ]) 42 | <*> (optional . option (parseUserEvent <$> str) $ mconcat [ 43 | long "window" 44 | , metavar "NAME" 45 | , help "Events named NAME act to mark bounds of visualization window." 46 | ]) 47 | <*> (option auto $ mconcat [ 48 | long "buckets" 49 | , short 'b' 50 | , metavar "INT" 51 | , help "Use INT buckets for quantization." 52 | , showDefault 53 | , value 1000 54 | ]) 55 | <*> (strOption $ mconcat [ 56 | long "start" 57 | , metavar "STR" 58 | , help "Use STR as the prefix for the start of user events" 59 | , showDefault 60 | , value "START " 61 | ]) 62 | <*> (strOption $ mconcat [ 63 | long "stop" 64 | , metavar "STR" 65 | , help "Use STR as the prefix for the end of user events" 66 | , showDefault 67 | , value "STOP " 68 | ]) 69 | <*> (strOption $ mconcat [ 70 | long "script-totals" 71 | , metavar "PATH" 72 | , help "Use the script in PATH for the totals report" 73 | , value "" 74 | ]) 75 | <*> (strOption $ mconcat [ 76 | long "script-timed" 77 | , metavar "PATH" 78 | , help "Use the script in PATH for the timed reports" 79 | , value "" 80 | ]) 81 | <*> parseTimelineGranularity 82 | <*> (option auto $ mconcat [ 83 | long "tick-every" 84 | , metavar "N" 85 | , help "Render a tick every N buckets" 86 | , value 1 87 | , showDefault 88 | ]) 89 | <*> (option auto $ mconcat [ 90 | long "bucket-width" 91 | , metavar "DOUBLE" 92 | , help "Width of every bucket" 93 | , value 14 94 | , showDefault 95 | ]) 96 | <*> (option auto $ mconcat [ 97 | long "bucket-height" 98 | , metavar "DOUBLE" 99 | , help "Height of every bucket" 100 | , value 14 101 | , showDefault 102 | ]) 103 | <*> (option auto $ mconcat [ 104 | long "border-width" 105 | , metavar "DOUBLE" 106 | , help "Width of the border around each bucket (set to 0 for none)" 107 | , value 0.1 108 | , showDefault 109 | ]) 110 | <*> argument str (metavar "EVENTLOG") 111 | )) 112 | 113 | parseTimelineGranularity :: Parser TimelineGranularity 114 | parseTimelineGranularity = asum [ 115 | flag' TimelineMilliseconds $ mconcat [ 116 | long "ms" 117 | , help "Use milliseconds (rather than seconds) on SVG timeline" 118 | ] 119 | , pure TimelineSeconds 120 | ] 121 | 122 | scriptHelp :: String 123 | scriptHelp = unlines [ 124 | "Scripts are used to drive report generation. The syntax for scripts is" 125 | , "" 126 | , "