ghc-prof 1.0.1 → 1.1.0

raw patch · 8 files changed

+60/−55 lines, 8 filesdep ~attoparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec

API changes (from Hackage documentation)

Files

• bin/dump.hs +3/−5
• ghc-prof.cabal +3/−2
• src/Control/Monad/Extras.hs +6/−0
• src/GHC/Prof.hs +0/−1
• src/GHC/Prof/CostCentreTree.hs +5/−20
• src/GHC/Prof/Parser.hs +11/−5
• src/GHC/Prof/Types.hs +3/−18
• tests/Regression.hs +29/−4

@@ -9,7 +9,6 @@  import Data.Scientific import Data.Tree (drawTree)-import qualified Data.Attoparsec.Text.Lazy as ATL import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TLIO @@ -19,10 +18,9 @@ main = do   (opts, file:restArgs) <- parseOpts =<< getArgs   text <- TLIO.readFile file-  case ATL.parse profile text of-    ATL.Fail unconsumed contexts reason ->-      fail $ show (unconsumed, contexts, reason)-    ATL.Done _ prof -> case optMode opts of+  case decode text of+    Left reason -> fail reason+    Right prof -> case optMode opts of       AggregateMode ->         traverse_ (putStrLn . makeAggregateCCName) $ aggregateCostCentres prof       TreeMode -> case restArgs of

@@ -1,5 +1,5 @@ name: ghc-prof-version: 1.0.1+version: 1.1.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@@ -23,6 +23,8 @@     GHC.Prof.Parser     GHC.Prof.Types     GHC.Prof.CostCentreTree+  other-modules:+    Control.Monad.Extras   build-depends:       base == 4.*     , attoparsec < 0.14@@ -44,7 +46,6 @@   hs-source-dirs: bin   build-depends:       base-    , attoparsec     , containers     , ghc-prof     , scientific < 0.4

@@ -0,0 +1,6 @@+module Control.Monad.Extras (seqM) where++seqM :: Monad m => m a -> m a+seqM m = do+  a <- m+  return $! a

@@ -20,7 +20,6 @@   , AggregateCostCentre(..)   , CostCentre(..)   , CostCentreNo-  , Callee(..)   , CallSite(..)   ) where 

@@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -fsimpl-tick-factor=115 #-}+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} module GHC.Prof.CostCentreTree   ( aggregateCostCentres   , aggregateCostCentresOrderBy@@ -18,7 +18,6 @@   ) where import Control.Applicative import Control.Arrow ((&&&))-import Data.Foldable (asum) import Data.Function (on) import Data.List import Data.Maybe (listToMaybe)@@ -26,7 +25,6 @@ import Prelude hiding (mapM) import qualified Data.Foldable as Fold -import Data.Set (Set) import Data.Text (Text) import Data.Tree (Tree) import qualified Data.Set as Set@@ -88,7 +86,7 @@   -> Text   -- ^ Module name   -> Profile-  -> Maybe (Callee, [CallSite])+  -> Maybe (AggregateCostCentre, [CallSite]) callSites = callSitesOrderBy sortKey   where     sortKey =@@ -107,7 +105,7 @@   -> Text   -- ^ Module name   -> Profile-  -> Maybe (Callee, [CallSite])+  -> Maybe (AggregateCostCentre, [CallSite]) callSitesOrderBy sortKey name modName =   buildCallSitesOrderBy sortKey name modName . profileCostCentreTree @@ -151,29 +149,16 @@   -> Text   -- ^ Module name   -> CostCentreTree-  -> Maybe (Callee, [CallSite])+  -> Maybe (AggregateCostCentre, [CallSite]) buildCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} =   (,) <$> callee <*> callers   where     lookupCallees = Map.lookup (name, modName) costCentreCallSites-    !callee = do-      callees <- lookupCallees-      return $ buildCallee name modName callees+    callee = Map.lookup (name, modName) costCentreAggregate     callers = do       callees <- lookupCallees       mapM (buildCallSite tree) $         sortBy (flip compare `on` sortKey) $ Set.toList callees--buildCallee :: Text -> Text -> Set CostCentre -> Callee-buildCallee name modName callees = Callee-  { calleeName = name-  , calleeModule = modName-  , calleeEntries = Fold.sum $ Set.map costCentreEntries callees-  , calleeTime = Fold.sum $ Set.map costCentreIndTime callees-  , calleeAlloc = Fold.sum $ Set.map costCentreIndAlloc callees-  , calleeTicks = asum $ Set.map costCentreTicks callees-  , calleeBytes = asum $ Set.map costCentreBytes callees-  }  buildCallSite :: CostCentreTree -> CostCentre -> Maybe CallSite buildCallSite CostCentreTree {..} CostCentre {..} = do

@@ -27,6 +27,7 @@  import Data.Attoparsec.Text as A +import Control.Monad.Extras (seqM) import GHC.Prof.Types  #if MIN_VERSION_containers(0, 5, 0)@@ -93,8 +94,8 @@   void $ string " secs"; skipSpace   (ticks, resolution, processors) <- parens $ (,,)     <$> decimal <* string " ticks @ "-    <*> picoSeconds <* string ", "-    <*> decimal <* many1 (notChar ')')+    <*> picoSeconds+    <*> optional (string ", " *> decimal <* many1 (notChar ')'))   return $! TotalTime     { totalTimeElapsed = elapsed     , totalTimeTicks = ticks@@ -158,6 +159,7 @@   <$> symbol <* skipHorizontalSpace -- name   <*> symbol <* skipHorizontalSpace -- module   <*> source <* skipHorizontalSpace -- src+  <*> pure Nothing -- entries   <*> scientific <* skipHorizontalSpace -- %time   <*> scientific <* skipHorizontalSpace -- %alloc   <*> optional decimal <* skipHorizontalSpace -- ticks@@ -279,6 +281,7 @@               { aggregateCostCentreName = costCentreName node               , aggregateCostCentreModule = costCentreModule node               , aggregateCostCentreSrc = costCentreSrc node+              , aggregateCostCentreEntries = Just $! costCentreEntries node               , aggregateCostCentreTime = costCentreIndTime node               , aggregateCostCentreAlloc = costCentreIndAlloc node               , aggregateCostCentreTicks = costCentreTicks node@@ -287,14 +290,17 @@             costCentreAggregate           }         addCostCentre x y = x-          { aggregateCostCentreTime =+          { aggregateCostCentreEntries = seqM $ (+)+            <$> aggregateCostCentreEntries x+            <*> aggregateCostCentreEntries y+          , aggregateCostCentreTime =             aggregateCostCentreTime x + aggregateCostCentreTime y           , aggregateCostCentreAlloc =             aggregateCostCentreAlloc x + aggregateCostCentreAlloc y-          , aggregateCostCentreTicks = (+)+          , aggregateCostCentreTicks = seqM $ (+)             <$> aggregateCostCentreTicks x             <*> aggregateCostCentreTicks y-          , aggregateCostCentreBytes = (+)+          , aggregateCostCentreBytes = seqM $ (+)             <$> aggregateCostCentreBytes x             <*> aggregateCostCentreBytes y           }

@@ -28,7 +28,7 @@   -- ^ Total number of ticks   , totalTimeResolution :: !DiffTime   -- ^ Duration of a tick-  , totalTimeProcessors :: !Int+  , totalTimeProcessors :: !(Maybe Int)   -- ^ Number of processors   } deriving Show @@ -45,6 +45,8 @@   -- ^ Module name of the cost-centre   , aggregateCostCentreSrc :: !(Maybe Text)   -- ^ Source location of the cost-centre+  , aggregateCostCentreEntries :: !(Maybe Integer)+  -- ^ Number of entries to the cost-centre   , aggregateCostCentreTime :: !Scientific   -- ^ Total time spent in the cost-centre   , aggregateCostCentreAlloc :: !Scientific@@ -101,23 +103,6 @@   , costCentreCallSites = mempty   , costCentreAggregate = mempty   }--data Callee = Callee-  { calleeName :: Text-  -- ^ Name of the callee function-  , calleeModule :: Text-  -- ^ Module name of the calle function-  , calleeEntries :: !Integer-  -- ^ Number of entries to the callee function-  , calleeTime :: !Scientific-  -- ^ Time spent in the callee function-  , calleeAlloc :: !Scientific-  -- ^ Allocation incurred by the callee function-  , calleeTicks :: !(Maybe Integer)-  -- ^ Number of ticks in the callee function-  , calleeBytes :: !(Maybe Integer)-  -- ^ Number of allocated bytes in the callee function-  } deriving Show  data CallSite = CallSite   { callSiteCostCentre :: CostCentre

@@ -1,10 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} module Main where-import Data.Foldable-import Data.Traversable import Control.Applicative import Control.Monad+import Data.Foldable+import Data.Monoid+import Data.Traversable import System.Directory import System.FilePath import System.IO@@ -61,12 +62,36 @@   text <- TL.readFile path   case ATL.parse profile text of     ATL.Done _ prof -> do-      let actual = Set.fromList $ aggregateCostCentres prof-          expected = Set.fromList $ profileTopCostCentres prof+      let actual = Set.fromList $ map Similar $ aggregateCostCentres 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++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+++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)  #if !MIN_VERSION_directory(1, 2, 3) withCurrentDirectory :: FilePath -> IO a -> IO a