ghc-prof 1.0.0 → 1.0.1

raw patch · 6 files changed

+69/−39 lines, 6 filesdep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• ghc-prof.cabal +2/−1
• src/GHC/Prof.hs +20/−8
• src/GHC/Prof/CostCentreTree.hs +18/−13
• src/GHC/Prof/Parser.hs +7/−6
• src/GHC/Prof/Types.hs +8/−8
• tests/Regression.hs +14/−3

@@ -1,5 +1,5 @@ name: ghc-prof-version: 1.0.0+version: 1.0.1 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@@ -59,6 +59,7 @@   build-depends:       attoparsec >= 0.10 && < 0.14     , base+    , containers     , directory     , filepath     , ghc-prof

@@ -1,12 +1,5 @@ module GHC.Prof-  ( Profile(..)-  , TotalTime(..)-  , TotalAlloc(..)-  , AggregateCostCentre(..)-  , CostCentre(..)-  , CostCentreNo-  , Callee(..)-  , CallSite(..)+  ( decode    -- * Parser   , profile@@ -19,8 +12,27 @@   , costCentresOrderBy   , callSites   , callSitesOrderBy++  -- * Types+  , Profile(..)+  , TotalTime(..)+  , TotalAlloc(..)+  , AggregateCostCentre(..)+  , CostCentre(..)+  , CostCentreNo+  , Callee(..)+  , CallSite(..)   ) where +import qualified Data.Attoparsec.Text.Lazy as ATL+import qualified Data.Text.Lazy as TL+ import GHC.Prof.CostCentreTree import GHC.Prof.Parser (profile) import GHC.Prof.Types++-- | Decode a GHC time allocation profiling report from a lazy 'ATL.Text'+decode :: TL.Text -> Either String Profile+decode text = case ATL.parse profile text of+  ATL.Fail _unconsumed _contexts reason -> Left reason+  ATL.Done _unconsumed prof -> Right prof

@@ -12,6 +12,7 @@   , callSites   , callSitesOrderBy +  , buildAggregateCostCentresOrderBy   , buildCostCentresOrderBy   , buildCallSitesOrderBy   ) where@@ -24,11 +25,11 @@ import Data.Traversable (mapM) import Prelude hiding (mapM) import qualified Data.Foldable as Fold-import qualified Data.Sequence as Seq -import Data.Sequence (Seq)+import Data.Set (Set) import Data.Text (Text) import Data.Tree (Tree)+import qualified Data.Set as Set import qualified Data.Tree as Tree  import GHC.Prof.Types@@ -41,11 +42,15 @@ import qualified Data.Map as Map #endif +-- | 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   where     sortKey = aggregateCostCentreTime &&& aggregateCostCentreAlloc +-- | Build a list of cost-centres from a profling report ordered by the given+-- key. aggregateCostCentresOrderBy   :: Ord a   => (AggregateCostCentre -> a)@@ -83,7 +88,7 @@   -> Text   -- ^ Module name   -> Profile-  -> Maybe (Callee, Seq CallSite)+  -> Maybe (Callee, [CallSite]) callSites = callSitesOrderBy sortKey   where     sortKey =@@ -102,7 +107,7 @@   -> Text   -- ^ Module name   -> Profile-  -> Maybe (Callee, Seq CallSite)+  -> Maybe (Callee, [CallSite]) callSitesOrderBy sortKey name modName =   buildCallSitesOrderBy sortKey name modName . profileCostCentreTree @@ -135,7 +140,7 @@           !children = maybe [] Fold.toList $ do             nodes <- IntMap.lookup key costCentreChildren             return $ costCentreNo-                <$> Seq.unstableSortBy (flip compare `on` sortKey) nodes+              <$> sortBy (flip compare `on` sortKey) (Set.toList nodes)  buildCallSitesOrderBy   :: Ord a@@ -146,7 +151,7 @@   -> Text   -- ^ Module name   -> CostCentreTree-  -> Maybe (Callee, Seq CallSite)+  -> Maybe (Callee, [CallSite]) buildCallSitesOrderBy sortKey name modName tree@CostCentreTree {..} =   (,) <$> callee <*> callers   where@@ -157,17 +162,17 @@     callers = do       callees <- lookupCallees       mapM (buildCallSite tree) $-        Seq.unstableSortBy (flip compare `on` sortKey) callees+        sortBy (flip compare `on` sortKey) $ Set.toList callees -buildCallee :: Text -> Text -> Seq CostCentre -> Callee+buildCallee :: Text -> Text -> Set CostCentre -> Callee buildCallee name modName callees = Callee   { calleeName = name   , calleeModule = modName-  , calleeEntries = Fold.sum $ costCentreEntries <$> callees-  , calleeTime = Fold.sum $ costCentreIndTime <$> callees-  , calleeAlloc = Fold.sum $ costCentreIndAlloc <$> callees-  , calleeTicks = asum $ costCentreTicks <$> callees-  , calleeBytes = asum $ costCentreBytes <$> callees+  , 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

@@ -20,11 +20,10 @@ import Control.Monad import Data.Char (isSpace) import Data.Foldable (asum, foldl')-import Data.Sequence ((><)) import Data.Maybe import Data.Text (Text) import Data.Time-import qualified Data.Sequence as Seq+import qualified Data.Set as Set  import Data.Attoparsec.Text as A @@ -38,6 +37,7 @@ import qualified Data.Map as Map #endif +-- | Parse a GHC time-allocation profiling report profile :: Parser Profile profile = do   skipHorizontalSpace@@ -51,6 +51,7 @@   endOfInput   return $! Profile {..} +-- | Parse the timestamp in a header as local time timestamp :: Parser LocalTime timestamp = do   parseDayOfTheWeek >> skipSpace@@ -264,13 +265,13 @@             (\parent -> IntMap.insert ccNo parent costCentreParents)             parentNo           , costCentreChildren = maybe costCentreChildren-            (\parent -> IntMap.insertWith (><) parent-              (Seq.singleton node)+            (\parent -> IntMap.insertWith Set.union parent+              (Set.singleton node)               costCentreChildren)             parentNo-          , costCentreCallSites = Map.insertWith (><)+          , costCentreCallSites = Map.insertWith Set.union             (costCentreName node, costCentreModule node)-            (Seq.singleton node)+            (Set.singleton node)             costCentreCallSites           , costCentreAggregate = Map.insertWith addCostCentre             (costCentreName node, costCentreModule node)

@@ -6,7 +6,7 @@ import Data.IntMap (IntMap) import Data.Map (Map) import Data.Scientific (Scientific)-import Data.Sequence (Seq)+import Data.Set (Set) import Data.Text (Text) import Data.Time (DiffTime, LocalTime) @@ -55,18 +55,18 @@   , aggregateCostCentreBytes :: !(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+  } deriving (Show, Eq, Ord)  -- | Cost-centre node data CostCentre = CostCentre-  { costCentreName :: !Text+  { costCentreNo :: !CostCentreNo+  -- ^ Identifier of the cost-centre+  , costCentreName :: !Text   -- ^ Name of the cost-centre   , costCentreModule :: !Text   -- ^ Module name of the cost-centre   , costCentreSrc :: !(Maybe Text)   -- ^ Source location of the cost-centre-  , costCentreNo :: !CostCentreNo-  -- ^ Identifier of the cost-centre   , costCentreEntries :: !Integer   -- ^ Number of entries to the cost-centre   , costCentreIndTime :: !Scientific@@ -81,15 +81,15 @@   -- ^ Number of ticks in the cost-centre.   , costCentreBytes :: !(Maybe Integer)   -- ^ Number of allocated bytes in the cost-centre.-  } deriving Show+  } deriving (Show, Eq, Ord)  type CostCentreNo = Int  data CostCentreTree = CostCentreTree   { costCentreNodes :: !(IntMap CostCentre)   , costCentreParents :: !(IntMap CostCentreNo)-  , costCentreChildren :: !(IntMap (Seq CostCentre))-  , costCentreCallSites :: !(Map (Text, Text) (Seq CostCentre))+  , costCentreChildren :: !(IntMap (Set CostCentre))+  , costCentreCallSites :: !(Map (Text, Text) (Set CostCentre))   , costCentreAggregate :: !(Map (Text, Text) AggregateCostCentre)   } deriving Show 

@@ -14,8 +14,9 @@ import System.Process import Test.Tasty import Test.Tasty.HUnit-import qualified Data.Text.Lazy.IO as TL import qualified Data.Attoparsec.Text.Lazy as ATL+import qualified Data.Set as Set+import qualified Data.Text.Lazy.IO as TL  import GHC.Prof @@ -35,7 +36,12 @@ generateProfiles :: IO [FilePath] generateProfiles = do   withFile "hello.hs" WriteMode $ \h ->-    hPutStrLn h "main = putStrLn \"Hello, World!\""+    hPutStrLn h $ unlines+      [ "import Control.Exception"+      , "main = evaluate $ fib 100000"+      , "fib n = fibs !! n"+      , "fibs = 0:1:zipWith (+) fibs (tail fibs)"+      ]   void $ readProcess "ghc" ["-prof", "-rtsopts", "-fforce-recomp", "hello.hs"] ""   for profilingFlags $ \(name, flag) -> do     void $ readProcess "./hello" ["+RTS", flag, "-RTS"] ""@@ -54,7 +60,12 @@ assertProfile path = do   text <- TL.readFile path   case ATL.parse profile text of-    ATL.Done {} -> return ()+    ATL.Done _ prof -> do+      let actual = Set.fromList $ aggregateCostCentres prof+          expected = Set.fromList $ profileTopCostCentres prof+      assertBool+        ("Missing cost centre(s): " ++ show (Set.difference expected actual)) $+          Set.isSubsetOf expected actual     ATL.Fail _ _ reason -> assertFailure reason  #if !MIN_VERSION_directory(1, 2, 3)