diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for ghc-events + +## 1.4.0 (2017-02-14) + +* Rename AggregateCostCentre to AggregatedCostCentre diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,13 @@ +# ghc-prof: Library for parsing GHC time and allocation profiling reports + +[![Hackage](https://img.shields.io/hackage/v/ghc-prof.svg?maxAge=2592000)](https://hackage.haskell.org/package/ghc-prof) +[![Hackage-Deps](https://img.shields.io/hackage-deps/v/ghc-prof.svg?maxAge=2592000)](https://hackage.haskell.org/package/ghc-prof) +[![Stackage LTS](http://stackage.org/package/ghc-prof/badge/lts)](http://stackage.org/lts/package/ghc-prof) +[![Stackage Nightly](http://stackage.org/package/ghc-prof/badge/nightly)](http://stackage.org/nightly/package/ghc-prof) +[![Build Status](https://travis-ci.org/maoe/ghc-prof.svg?branch=master)](https://travis-ci.org/maoe/ghc-prof) +[![Gitter](https://img.shields.io/gitter/room/maoe/ghc-prof.svg?maxAge=2592000)](https://gitter.im/maoe/ghc-prof) + +## Applications + +* [profiteur](https://hackage.haskell.org/package/profiteur) +* [viewprof](https://hackage.haskell.org/package/viewprof) diff --git a/bin/dump.hs b/bin/dump.hs --- a/bin/dump.hs +++ b/bin/dump.hs @@ -22,7 +22,7 @@ Left reason -> fail reason Right prof -> case optMode opts of AggregateMode -> - traverse_ (putStrLn . makeAggregateCCName) $ aggregateCostCentres prof + traverse_ (putStrLn . makeAggregateCCName) $ aggregatedCostCentres prof TreeMode -> case restArgs of [] -> traverse_ putStrLn $ drawTree . fmap makeCCName <$> costCentres prof @@ -44,13 +44,13 @@ (showScientific $ costCentreInhAlloc cc) (showScientific $ costCentreIndAlloc cc) -makeAggregateCCName :: AggregateCostCentre -> String +makeAggregateCCName :: AggregatedCostCentre -> String makeAggregateCCName aggregate = printf "%s%%\t%s%%\t%s.%s" - (showScientific $ aggregateCostCentreTime aggregate) - (showScientific $ aggregateCostCentreAlloc aggregate) - (T.unpack $ aggregateCostCentreModule aggregate) - (T.unpack $ aggregateCostCentreName aggregate) + (showScientific $ aggregatedCostCentreTime aggregate) + (showScientific $ aggregatedCostCentreAlloc aggregate) + (T.unpack $ aggregatedCostCentreModule aggregate) + (T.unpack $ aggregatedCostCentreName aggregate) showScientific :: Scientific -> String showScientific = formatScientific Fixed Nothing diff --git a/ghc-prof.cabal b/ghc-prof.cabal --- a/ghc-prof.cabal +++ b/ghc-prof.cabal @@ -1,5 +1,5 @@ name: ghc-prof -version: 1.3.0.2 +version: 1.4.0 synopsis: Library for parsing GHC time and allocation profiling reports description: Library for parsing GHC time and allocation profiling reports homepage: https://github.com/maoe/ghc-prof @@ -7,9 +7,12 @@ license-file: LICENSE author: Mitsutoshi Aoe maintainer: Mitsutoshi Aoe -copyright: Copyright (C) 2013-2016 Mitsutoshi Aoe +copyright: Copyright (C) 2013-2017 Mitsutoshi Aoe category: Development build-type: Simple +extra-source-files: + CHANGELOG.md + README.md cabal-version: >=1.10 tested-with: GHC >= 7.6 && <= 8.0.2 diff --git a/src/GHC/Prof.hs b/src/GHC/Prof.hs --- a/src/GHC/Prof.hs +++ b/src/GHC/Prof.hs @@ -6,8 +6,8 @@ -- * Cost-centre tree , CostCentreTree - , aggregateCostCentres - , aggregateCostCentresOrderBy + , aggregatedCostCentres + , aggregatedCostCentresOrderBy , costCentres , costCentresOrderBy , aggregateCallSites @@ -21,7 +21,7 @@ , Profile(..) , TotalTime(..) , TotalAlloc(..) - , AggregateCostCentre(..) + , AggregatedCostCentre(..) , CostCentre(..) , CostCentreNo , CallSite(..) diff --git a/src/GHC/Prof/CostCentreTree.hs b/src/GHC/Prof/CostCentreTree.hs --- a/src/GHC/Prof/CostCentreTree.hs +++ b/src/GHC/Prof/CostCentreTree.hs @@ -5,8 +5,8 @@ module GHC.Prof.CostCentreTree ( -- * Cost center breakdown -- ** Aggregate cost centres - aggregateCostCentres - , aggregateCostCentresOrderBy + aggregatedCostCentres + , aggregatedCostCentresOrderBy -- ** Cost centre trees , costCentres @@ -26,7 +26,7 @@ , aggregateModulesOrderBy -- * Low level functions - , buildAggregateCostCentresOrderBy + , buildAggregatedCostCentresOrderBy , buildCostCentresOrderBy , buildCallSitesOrderBy , buildAggregateCallSitesOrderBy @@ -58,21 +58,21 @@ -- | Build a list of cost-centres from a profiling report ordered by the time -- spent and the amount of allocation. -aggregateCostCentres :: Profile -> [AggregateCostCentre] -aggregateCostCentres = aggregateCostCentresOrderBy sortKey +aggregatedCostCentres :: Profile -> [AggregatedCostCentre] +aggregatedCostCentres = aggregatedCostCentresOrderBy sortKey where - sortKey = aggregateCostCentreTime &&& aggregateCostCentreAlloc + sortKey = aggregatedCostCentreTime &&& aggregatedCostCentreAlloc -- | Build a list of cost-centres from a profling report ordered by the given -- key. -aggregateCostCentresOrderBy +aggregatedCostCentresOrderBy :: Ord a - => (AggregateCostCentre -> a) + => (AggregatedCostCentre -> a) -- ^ Sorting key function -> Profile - -> [AggregateCostCentre] -aggregateCostCentresOrderBy sortKey = - buildAggregateCostCentresOrderBy sortKey . profileCostCentreTree + -> [AggregatedCostCentre] +aggregatedCostCentresOrderBy sortKey = + buildAggregatedCostCentresOrderBy sortKey . profileCostCentreTree -- | Build a tree of cost-centres from a profiling report. costCentres :: Profile -> Maybe (Tree CostCentre) @@ -102,26 +102,26 @@ -> Text -- ^ Module name -> Profile - -> Maybe (AggregateCostCentre, [CallSite AggregateCostCentre]) + -> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre]) aggregateCallSites = aggregateCallSitesOrderBy sortKey where sortKey = callSiteContribTime &&& callSiteContribAlloc - &&& aggregateCostCentreTime . callSiteCostCentre - &&& aggregateCostCentreAlloc . callSiteCostCentre + &&& aggregatedCostCentreTime . callSiteCostCentre + &&& aggregatedCostCentreAlloc . callSiteCostCentre -- | Build a list of call sites (caller functions of a cost centre) aggregated -- by their cost centre names and module names. Call sites are sorted by the -- given key function. aggregateCallSitesOrderBy :: Ord a - => (CallSite AggregateCostCentre -> a) + => (CallSite AggregatedCostCentre -> a) -- ^ Sorting key function -> Text -- ^ Cost centre name -> Text -- ^ Module name -> Profile - -> Maybe (AggregateCostCentre, [CallSite AggregateCostCentre]) + -> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre]) aggregateCallSitesOrderBy sortKey name modName = buildAggregateCallSitesOrderBy sortKey name modName . profileCostCentreTree @@ -133,7 +133,7 @@ -> Text -- ^ Module name -> Profile - -> Maybe (AggregateCostCentre, [CallSite CostCentre]) + -> Maybe (AggregatedCostCentre, [CallSite CostCentre]) callSites = callSitesOrderBy sortKey where sortKey = callSiteContribTime &&& callSiteContribAlloc @@ -152,7 +152,7 @@ -> Text -- ^ Module name -> Profile - -> Maybe (AggregateCostCentre, [CallSite CostCentre]) + -> Maybe (AggregatedCostCentre, [CallSite CostCentre]) callSitesOrderBy sortKey name modName = buildCallSitesOrderBy sortKey name modName . profileCostCentreTree @@ -176,12 +176,12 @@ ----------------------------------------------------------- -buildAggregateCostCentresOrderBy +buildAggregatedCostCentresOrderBy :: Ord a - => (AggregateCostCentre -> a) + => (AggregatedCostCentre -> a) -> CostCentreTree - -> [AggregateCostCentre] -buildAggregateCostCentresOrderBy sortKey CostCentreTree {..} = + -> [AggregatedCostCentre] +buildAggregatedCostCentresOrderBy sortKey CostCentreTree {..} = sortBy (flip compare `on` sortKey) $ concatMap Map.elems $ Map.elems $ costCentreAggregate @@ -208,14 +208,14 @@ buildAggregateCallSitesOrderBy :: Ord a - => (CallSite AggregateCostCentre -> a) + => (CallSite AggregatedCostCentre -> a) -- ^ Sorting key function -> Text -- ^ Cost centre name -> Text -- ^ Module name -> CostCentreTree - -> Maybe (AggregateCostCentre, [CallSite AggregateCostCentre]) + -> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre]) buildAggregateCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} = (,) <$> callee <*> callers where @@ -227,9 +227,9 @@ buildAggregateCallSite :: CostCentreTree - -> Map.Map (Text, Text) (CallSite AggregateCostCentre) + -> Map.Map (Text, Text) (CallSite AggregatedCostCentre) -> CostCentre - -> Maybe (Map.Map (Text, Text) (CallSite AggregateCostCentre)) + -> Maybe (Map.Map (Text, Text) (CallSite AggregatedCostCentre)) buildAggregateCallSite CostCentreTree {..} parents CostCentre {..} = do parentNo <- IntMap.lookup costCentreNo costCentreParents parent <- IntMap.lookup parentNo costCentreNodes @@ -271,7 +271,7 @@ -> Text -- ^ Module name -> CostCentreTree - -> Maybe (AggregateCostCentre, [CallSite CostCentre]) + -> Maybe (AggregatedCostCentre, [CallSite CostCentre]) buildCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} = (,) <$> callee <*> callers where @@ -311,25 +311,25 @@ costCentreAggregate where aggregateModule modName = Map.foldl' add (emptyAggregateModule modName) - add aggMod AggregateCostCentre {..} = aggMod + add aggMod AggregatedCostCentre {..} = aggMod { aggregateModuleEntries = seqM $ (+) <$> aggregateModuleEntries aggMod - <*> aggregateCostCentreEntries + <*> aggregatedCostCentreEntries , aggregateModuleTime = - aggregateModuleTime aggMod + aggregateCostCentreTime + aggregateModuleTime aggMod + aggregatedCostCentreTime , aggregateModuleAlloc = - aggregateModuleAlloc aggMod + aggregateCostCentreAlloc + aggregateModuleAlloc aggMod + aggregatedCostCentreAlloc , aggregateModuleTicks = seqM $ (+) <$> aggregateModuleTicks aggMod - <*> aggregateCostCentreTicks + <*> aggregatedCostCentreTicks , aggregateModuleBytes = seqM $ (+) <$> aggregateModuleBytes aggMod - <*> aggregateCostCentreBytes + <*> aggregatedCostCentreBytes } lookupAggregate :: Text -- ^ Cost centre name -> Text -- ^ Module name - -> Map.Map Text (Map.Map Text AggregateCostCentre) - -> Maybe AggregateCostCentre + -> Map.Map Text (Map.Map Text AggregatedCostCentre) + -> Maybe AggregatedCostCentre lookupAggregate name modName m = Map.lookup modName m >>= Map.lookup name diff --git a/src/GHC/Prof/Parser.hs b/src/GHC/Prof/Parser.hs --- a/src/GHC/Prof/Parser.hs +++ b/src/GHC/Prof/Parser.hs @@ -13,7 +13,7 @@ , totalTime , totalAlloc , topCostCentres - , aggregateCostCentre + , aggregatedCostCentre , costCentres , costCentre ) where @@ -151,13 +151,13 @@ return HeaderParams {..} -topCostCentres :: Parser [AggregateCostCentre] +topCostCentres :: Parser [AggregatedCostCentre] topCostCentres = do params <- header; skipSpace - aggregateCostCentre params `sepBy1` endOfLine + aggregatedCostCentre params `sepBy1` endOfLine -aggregateCostCentre :: HeaderParams -> Parser AggregateCostCentre -aggregateCostCentre HeaderParams {..} = AggregateCostCentre +aggregatedCostCentre :: HeaderParams -> Parser AggregatedCostCentre +aggregatedCostCentre HeaderParams {..} = AggregatedCostCentre <$> symbol <* skipHorizontalSpace -- name <*> symbol <* skipHorizontalSpace -- module <*> source <* skipHorizontalSpace -- src @@ -282,19 +282,19 @@ (costCentreModule node) costCentreAggregate } - aggregate = AggregateCostCentre - { aggregateCostCentreName = costCentreName node - , aggregateCostCentreModule = costCentreModule node - , aggregateCostCentreSrc = costCentreSrc node - , aggregateCostCentreEntries = Just $! costCentreEntries node - , aggregateCostCentreTime = costCentreIndTime node - , aggregateCostCentreAlloc = costCentreIndAlloc node - , aggregateCostCentreTicks = costCentreTicks node - , aggregateCostCentreBytes = costCentreBytes node + aggregate = AggregatedCostCentre + { aggregatedCostCentreName = costCentreName node + , aggregatedCostCentreModule = costCentreModule node + , aggregatedCostCentreSrc = costCentreSrc node + , aggregatedCostCentreEntries = Just $! costCentreEntries node + , aggregatedCostCentreTime = costCentreIndTime node + , aggregatedCostCentreAlloc = costCentreIndAlloc node + , aggregatedCostCentreTicks = costCentreTicks node + , aggregatedCostCentreBytes = costCentreBytes node } updateCostCentre - :: Maybe (Map.Map Text AggregateCostCentre) - -> Map.Map Text AggregateCostCentre + :: Maybe (Map.Map Text AggregatedCostCentre) + -> Map.Map Text AggregatedCostCentre updateCostCentre = \case Nothing -> Map.singleton (costCentreName node) aggregate Just costCentreByName -> @@ -304,19 +304,19 @@ aggregate costCentreByName addCostCentre x y = x - { aggregateCostCentreEntries = seqM $ (+) - <$> aggregateCostCentreEntries x - <*> aggregateCostCentreEntries y - , aggregateCostCentreTime = - aggregateCostCentreTime x + aggregateCostCentreTime y - , aggregateCostCentreAlloc = - aggregateCostCentreAlloc x + aggregateCostCentreAlloc y - , aggregateCostCentreTicks = seqM $ (+) - <$> aggregateCostCentreTicks x - <*> aggregateCostCentreTicks y - , aggregateCostCentreBytes = seqM $ (+) - <$> aggregateCostCentreBytes x - <*> aggregateCostCentreBytes y + { aggregatedCostCentreEntries = seqM $ (+) + <$> aggregatedCostCentreEntries x + <*> aggregatedCostCentreEntries y + , aggregatedCostCentreTime = + aggregatedCostCentreTime x + aggregatedCostCentreTime y + , aggregatedCostCentreAlloc = + aggregatedCostCentreAlloc x + aggregatedCostCentreAlloc y + , aggregatedCostCentreTicks = seqM $ (+) + <$> aggregatedCostCentreTicks x + <*> aggregatedCostCentreTicks y + , aggregatedCostCentreBytes = seqM $ (+) + <$> aggregatedCostCentreBytes x + <*> aggregatedCostCentreBytes y } howMany :: Parser a -> Parser Int diff --git a/src/GHC/Prof/Types.hs b/src/GHC/Prof/Types.hs --- a/src/GHC/Prof/Types.hs +++ b/src/GHC/Prof/Types.hs @@ -16,7 +16,7 @@ , profileCommandLine :: !Text , profileTotalTime :: !TotalTime , profileTotalAlloc :: !TotalAlloc - , profileTopCostCentres :: [AggregateCostCentre] + , profileTopCostCentres :: [AggregatedCostCentre] , profileCostCentreTree :: !CostCentreTree } deriving Show @@ -38,23 +38,23 @@ -- ^ Total memory allocation in bytes } deriving Show -data AggregateCostCentre = AggregateCostCentre - { aggregateCostCentreName :: !Text +data AggregatedCostCentre = AggregatedCostCentre + { aggregatedCostCentreName :: !Text -- ^ Name of the cost-centre - , aggregateCostCentreModule :: !Text + , aggregatedCostCentreModule :: !Text -- ^ Module name of the cost-centre - , aggregateCostCentreSrc :: !(Maybe Text) + , aggregatedCostCentreSrc :: !(Maybe Text) -- ^ Source location of the cost-centre - , aggregateCostCentreEntries :: !(Maybe Integer) + , aggregatedCostCentreEntries :: !(Maybe Integer) -- ^ Number of entries to the cost-centre - , aggregateCostCentreTime :: !Scientific + , aggregatedCostCentreTime :: !Scientific -- ^ Total time spent in the cost-centre - , aggregateCostCentreAlloc :: !Scientific + , aggregatedCostCentreAlloc :: !Scientific -- ^ Total allocation in the cost-centre - , aggregateCostCentreTicks :: !(Maybe Integer) + , aggregatedCostCentreTicks :: !(Maybe Integer) -- ^ Total ticks in the cost-centre. This number exists only if -- @-P@ or @-Pa@ option is given at run-time. - , aggregateCostCentreBytes :: !(Maybe Integer) + , aggregatedCostCentreBytes :: !(Maybe Integer) -- ^ Total memory allocation in the cost-centre. This number -- exists only if @-P@ or @-Pa@ option is given at run-time. } deriving (Show, Eq, Ord) @@ -92,7 +92,7 @@ , costCentreParents :: !(IntMap CostCentreNo) , costCentreChildren :: !(IntMap (Set CostCentre)) , costCentreCallSites :: !(Map (Text, Text) (Set CostCentre)) - , costCentreAggregate :: !(Map Text (Map Text AggregateCostCentre)) + , costCentreAggregate :: !(Map Text (Map Text AggregatedCostCentre)) } deriving Show emptyCostCentreTree :: CostCentreTree diff --git a/tests/Regression.hs b/tests/Regression.hs --- a/tests/Regression.hs +++ b/tests/Regression.hs @@ -62,36 +62,36 @@ text <- TL.readFile path case ATL.parse profile text of ATL.Done _ prof -> do - let actual = Set.fromList $ map Similar $ aggregateCostCentres prof + let actual = Set.fromList $ map Similar $ aggregatedCostCentres prof expected = Set.fromList $ map Similar $ profileTopCostCentres prof assertBool ("Missing cost centre(s): " ++ show (Set.difference expected actual)) $ Set.isSubsetOf expected actual ATL.Fail _ _ reason -> assertFailure reason -newtype Similar = Similar AggregateCostCentre +newtype Similar = Similar AggregatedCostCentre instance Show Similar where show (Similar a) = show a instance Eq Similar where Similar a == Similar b = - aggregateCostCentreName a == aggregateCostCentreName b - && aggregateCostCentreModule a == aggregateCostCentreModule b - && aggregateCostCentreTime a == aggregateCostCentreTime b - && aggregateCostCentreAlloc a == aggregateCostCentreAlloc b - && aggregateCostCentreTicks a == aggregateCostCentreTicks b - && aggregateCostCentreBytes a == aggregateCostCentreBytes b + aggregatedCostCentreName a == aggregatedCostCentreName b + && aggregatedCostCentreModule a == aggregatedCostCentreModule b + && aggregatedCostCentreTime a == aggregatedCostCentreTime b + && aggregatedCostCentreAlloc a == aggregatedCostCentreAlloc b + && aggregatedCostCentreTicks a == aggregatedCostCentreTicks b + && aggregatedCostCentreBytes a == aggregatedCostCentreBytes b instance Ord Similar where compare (Similar a) (Similar b) = - compare (aggregateCostCentreName a) (aggregateCostCentreName b) - <> compare (aggregateCostCentreModule a) (aggregateCostCentreModule b) - <> compare (aggregateCostCentreTime a) (aggregateCostCentreTime b) - <> compare (aggregateCostCentreAlloc a) (aggregateCostCentreAlloc b) - <> compare (aggregateCostCentreTicks a) (aggregateCostCentreTicks b) - <> compare (aggregateCostCentreBytes a) (aggregateCostCentreBytes b) + compare (aggregatedCostCentreName a) (aggregatedCostCentreName b) + <> compare (aggregatedCostCentreModule a) (aggregatedCostCentreModule b) + <> compare (aggregatedCostCentreTime a) (aggregatedCostCentreTime b) + <> compare (aggregatedCostCentreAlloc a) (aggregatedCostCentreAlloc b) + <> compare (aggregatedCostCentreTicks a) (aggregatedCostCentreTicks b) + <> compare (aggregatedCostCentreBytes a) (aggregatedCostCentreBytes b) #if !MIN_VERSION_directory(1, 2, 3) withCurrentDirectory :: FilePath -> IO a -> IO a