ghc-events-analyze 0.2.1 → 0.2.2
raw patch · 6 files changed
+74/−18 lines, 6 filesdep ~SVGFontsdep ~basedep ~diagrams-lib
Dependency ranges changed: SVGFonts, base, diagrams-lib, diagrams-svg, filepath, lens, th-lift
Files
- ChangeLog +4/−0
- ghc-events-analyze.cabal +10/−9
- src/GHC/RTS/Events/Analyze/Analysis.hs +1/−0
- src/GHC/RTS/Events/Analyze/Reports/Timed/SVG.hs +52/−8
- src/GHC/RTS/Events/Analyze/Script.hs +5/−0
- src/GHC/RTS/Events/Analyze/StrictState.hs +2/−1
ChangeLog view
@@ -1,3 +1,7 @@+2014-09-23 Will Sewell <will@pusher.com>++ * Version 0.2.2 adds support for GHC 7.10+ 2014-02-12 Edsko de Vries <edsko@well-typed.com> * Initial release
ghc-events-analyze.cabal view
@@ -1,5 +1,5 @@ name: ghc-events-analyze-version: 0.2.1+version: 0.2.2 synopsis: Analyze and visualize event logs description: ghc-events-analyze is a simple Haskell profiling tool that uses GHC's eventlog system. It helps with some profiling@@ -51,19 +51,19 @@ GHC.RTS.Events.Analyze.Reports.Timed GHC.RTS.Events.Analyze.Reports.Timed.SVG - build-depends: base >= 4.5 && < 4.8,+ build-depends: base >= 4.5 && < 4.9, ghc-events >= 0.4 && < 0.5, optparse-applicative >= 0.11 && < 0.12,- diagrams-lib >= 1.2 && < 1.3,- diagrams-svg >= 1.1 && < 1.3,- SVGFonts >= 1.4 && < 1.5,+ diagrams-lib >= 1.2 && < 1.4,+ diagrams-svg >= 1.1 && < 1.4,+ SVGFonts >= 1.4 && < 1.6, containers >= 0.5 && < 0.6,- lens >= 3.10 && < 4.5,+ lens >= 3.10 && < 4.13, mtl >= 2.2.1 && < 2.3, transformers >= 0.3 && < 0.5,- filepath >= 1.3 && < 1.4,+ filepath >= 1.3 && < 1.5, parsec >= 3.1 && < 3.2,- th-lift >= 0.6 && < 0.7,+ th-lift >= 0.6 && < 0.8, -- No version: whatever is bundled with ghc template-haskell @@ -79,5 +79,6 @@ BangPatterns RankNTypes MultiParamTypeClasses- other-extensions: TemplateHaskell+ other-extensions: CPP+ TemplateHaskell QuasiQuotes
src/GHC/RTS/Events/Analyze/Analysis.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} module GHC.RTS.Events.Analyze.Analysis ( -- * Auxiliary readEventLog
src/GHC/RTS/Events/Analyze/Reports/Timed/SVG.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-} module GHC.RTS.Events.Analyze.Reports.Timed.SVG ( writeReport ) where@@ -5,13 +7,24 @@ import Data.Maybe (catMaybes) import Data.Monoid (mempty, mconcat, (<>)) import Diagrams.Backend.SVG (B, renderSVG)-import Diagrams.Prelude (Diagram, Colour, R2, SizeSpec2D, (#), (|||))+#if MIN_VERSION_diagrams_lib(1,3,0)+import Diagrams.Prelude (QDiagram, Colour, V2, N, Any, (#), (|||))+#else+import Diagrams.Prelude (Diagram, Colour, R2, (#), (|||))+#endif import GHC.RTS.Events (Timestamp)-import Graphics.SVGFonts.ReadFont (TextOpts(..)) import Text.Printf (printf) import qualified Data.Map as Map import qualified Diagrams.Prelude as D++#if MIN_VERSION_SVGFonts(1,5,0)+import Graphics.SVGFonts.Text (TextOpts(..))+import qualified Graphics.SVGFonts.Text as F+import qualified Graphics.SVGFonts.Fonts as F+#else+import Graphics.SVGFonts.ReadFont (TextOpts(..)) import qualified Graphics.SVGFonts.ReadFont as F+#endif import GHC.RTS.Events.Analyze.Types import GHC.RTS.Events.Analyze.Reports.Timed hiding (writeReport)@@ -20,13 +33,27 @@ writeReport options quantized report path = uncurry (renderSVG path) $ renderReport options quantized report +#if MIN_VERSION_diagrams_lib(1,3,0)+type D = QDiagram B V2 (N B) Any+type SizeSpec = D.SizeSpec V2 Double+#else type D = Diagram B R2+type SizeSpec = D.SizeSpec2D+#endif -renderReport :: Options -> Quantized -> Report -> (SizeSpec2D, D)+renderReport :: Options -> Quantized -> Report -> (SizeSpec, D) renderReport Options{optionsNumBuckets, optionsMilliseconds} Quantized{quantBucketSize}- report = (D.sizeSpec2D rendered, rendered)+ report = (sizeSpec, rendered) where+#if MIN_VERSION_diagrams_lib(1,3,0)+ sizeSpec = let w = Just $ D.width rendered+ h = Just $ D.height rendered+ in D.mkSizeSpec2D w h+#else+ sizeSpec = D.sizeSpec2D rendered+#endif+ rendered :: D rendered = D.vcat $ map (uncurry renderSVGFragment) $ zip (cycle [D.white, D.ghostwhite])@@ -104,14 +131,26 @@ renderText :: String -> Double -> D renderText str size =- D.stroke (F.textSVG' (textOpts str size)) # D.fc D.black # D.lc D.black # D.alignL # D.lw D.none-+ D.stroke textSVG # D.fc D.black # D.lc D.black # D.alignL # D.lw D.none+ where+#if MIN_VERSION_SVGFonts(1,5,0)+ textSVG = F.textSVG' (textOpts size) str+#else+ textSVG = F.textSVG' (textOpts str size)+#endif +#if MIN_VERSION_SVGFonts(1,5,0)+textOpts :: Double -> TextOpts Double+textOpts size =+ TextOpts {+ textFont = F.lin+#else textOpts :: String -> Double -> TextOpts textOpts str size = TextOpts { txt = str , fdo = F.lin+#endif , mode = F.INSIDE_H , spacing = F.KERN , underline = False@@ -158,10 +197,15 @@ blockMod = 10 `div` (round blockWidth) timelineBlock b | b `rem` (5 * blockMod) == 0- = D.strokeLine bigLine # D.lw (D.Local 0.5)+ = D.strokeLine bigLine # D.lw (localMeasure 0.5) <> (renderText (bucketTime b) blockHeight # D.translateY (blockHeight - 2)) | otherwise- = D.strokeLine smallLine # D.lw (D.Local 0.5) # D.translateY 1+ = D.strokeLine smallLine # D.lw (localMeasure 0.5) # D.translateY 1+#if MIN_VERSION_diagrams_lib(1,3,0)+ localMeasure = D.local+#else+ localMeasure = D.Local+#endif bucketTime :: Int -> String bucketTime b = let timeNs :: Timestamp
src/GHC/RTS/Events/Analyze/Script.hs view
@@ -1,5 +1,6 @@ {-# OPTIONS_GHC -w -W #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module GHC.RTS.Events.Analyze.Script ( -- * Types Script@@ -18,7 +19,9 @@ import Control.Applicative ((<$>), (<*>), (*>), (<*), pure) import Data.List (intercalate)+#if !MIN_VERSION_template_haskell(2,10,0) import Data.Word (Word32)+#endif import Language.Haskell.TH.Lift (deriveLiftMany) import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax@@ -195,8 +198,10 @@ $(deriveLiftMany [''EventId, ''EventFilter, ''EventSort, ''Command]) +#if !MIN_VERSION_template_haskell(2,10,0) instance Lift Word32 where lift = let conv :: Word32 -> Int ; conv = fromEnum in lift . conv+#endif scriptQQ :: QuasiQuoter scriptQQ = QuasiQuoter {
src/GHC/RTS/Events/Analyze/StrictState.hs view
@@ -16,6 +16,7 @@ , module Control.Monad.State.Strict ) where +import Control.Applicative import Control.Monad.IO.Class (MonadIO) import Control.Monad.State.Strict (MonadState(..)) import qualified Control.Monad.State.Strict as St@@ -27,7 +28,7 @@ -------------------------------------------------------------------------------} newtype StateT s m a = StateT { unStateT :: St.StateT s m a }- deriving (Functor, Monad, MonadTrans, MonadIO)+ deriving (Functor, Applicative, Monad, MonadTrans, MonadIO) runStateT :: StateT s m a -> s -> m (a, s) runStateT = St.runStateT . unStateT