ghc-prof 1.3.0.2 → 1.4.0

raw patch · 9 files changed

+121/−100 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +13/−0
• bin/dump.hs +6/−6
• ghc-prof.cabal +5/−2
• src/GHC/Prof.hs +3/−3
• src/GHC/Prof/CostCentreTree.hs +35/−35
• src/GHC/Prof/Parser.hs +29/−29
• src/GHC/Prof/Types.hs +11/−11
• tests/Regression.hs +14/−14

@@ -0,0 +1,5 @@+# Revision history for ghc-events++## 1.4.0 (2017-02-14)++* Rename AggregateCostCentre to AggregatedCostCentre

@@ -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)

@@ -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

@@ -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 <maoe@foldr.in>-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 

@@ -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(..)

@@ -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

@@ -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

@@ -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

@@ -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