{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}
module GHC.Prof.CostCentreTree
  ( -- * Cost center breakdown
  -- ** Aggregate cost centres
    aggregatedCostCentres
  , aggregatedCostCentresOrderBy

  -- ** Cost centre trees
  , costCentres
  , costCentresOrderBy

  -- * Call site breakdown
  -- ** Aggregate call sites
  , aggregateCallSites
  , aggregateCallSitesOrderBy

  -- ** Call sites
  , callSites
  , callSitesOrderBy

  -- * Module breakdown
  , aggregateModules
  , aggregateModulesOrderBy

  -- * Low level functions
  , buildAggregatedCostCentresOrderBy
  , buildCostCentresOrderBy
  , buildCallSitesOrderBy
  , buildAggregateCallSitesOrderBy
  ) where
import Control.Applicative
import Control.Arrow ((&&&))
import Control.Monad
import Data.Function (on)
import Data.List
import Data.Maybe (listToMaybe)
import Prelude hiding (mapM)
import qualified Data.Foldable as Fold

import Data.Text (Text)
import Data.Tree (Tree)
import qualified Data.Set as Set
import qualified Data.Tree as Tree

import Control.Monad.Extras (seqM)
import GHC.Prof.Types as Types

#if MIN_VERSION_containers(0, 5, 0)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
#else
import qualified Data.IntMap as IntMap
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.
aggregatedCostCentres :: Profile -> [AggregatedCostCentre]
aggregatedCostCentres :: Profile -> [AggregatedCostCentre]
aggregatedCostCentres = forall a.
Ord a =>
(AggregatedCostCentre -> a) -> Profile -> [AggregatedCostCentre]
aggregatedCostCentresOrderBy AggregatedCostCentre -> (Scientific, Scientific)
sortKey
  where
    sortKey :: AggregatedCostCentre -> (Scientific, Scientific)
sortKey = AggregatedCostCentre -> Scientific
aggregatedCostCentreTime forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AggregatedCostCentre -> Scientific
aggregatedCostCentreAlloc

-- | Build a list of cost-centres from a profling report ordered by the given
-- key.
aggregatedCostCentresOrderBy
  :: Ord a
  => (AggregatedCostCentre -> a)
  -- ^ Sorting key function
  -> Profile
  -> [AggregatedCostCentre]
aggregatedCostCentresOrderBy :: forall a.
Ord a =>
(AggregatedCostCentre -> a) -> Profile -> [AggregatedCostCentre]
aggregatedCostCentresOrderBy AggregatedCostCentre -> a
sortKey =
  forall a.
Ord a =>
(AggregatedCostCentre -> a)
-> CostCentreTree -> [AggregatedCostCentre]
buildAggregatedCostCentresOrderBy AggregatedCostCentre -> a
sortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> CostCentreTree
profileCostCentreTree

-- | Build a tree of cost-centres from a profiling report.
costCentres :: Profile -> Maybe (Tree CostCentre)
costCentres :: Profile -> Maybe (Tree CostCentre)
costCentres = forall a.
Ord a =>
(CostCentre -> a) -> Profile -> Maybe (Tree CostCentre)
costCentresOrderBy CostCentre -> (Scientific, (Scientific, (Scientific, Scientific)))
sortKey
  where
    sortKey :: CostCentre -> (Scientific, (Scientific, (Scientific, Scientific)))
sortKey =
      CostCentre -> Scientific
costCentreInhTime forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CostCentre -> Scientific
costCentreIndTime forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
      CostCentre -> Scientific
costCentreInhAlloc forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CostCentre -> Scientific
costCentreIndAlloc

-- | Build a tree of cost-centres from a profiling report.
-- Nodes are sorted by the given key function for each level
-- of the tree.
costCentresOrderBy
  :: Ord a
  => (CostCentre -> a)
  -- ^ Sorting key function
  -> Profile
  -> Maybe (Tree CostCentre)
costCentresOrderBy :: forall a.
Ord a =>
(CostCentre -> a) -> Profile -> Maybe (Tree CostCentre)
costCentresOrderBy CostCentre -> a
sortKey =
  forall a.
Ord a =>
(CostCentre -> a) -> CostCentreTree -> Maybe (Tree CostCentre)
buildCostCentresOrderBy CostCentre -> a
sortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> CostCentreTree
profileCostCentreTree

-- | Build a list of call sites (caller functions of a cost centre) aggregated
-- by their cost centre names and module names.
aggregateCallSites
  :: Text
  -- ^ Cost centre name
  -> Text
  -- ^ Module name
  -> Profile
  -> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
aggregateCallSites :: Text
-> Text
-> Profile
-> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
aggregateCallSites = forall a.
Ord a =>
(CallSite AggregatedCostCentre -> a)
-> Text
-> Text
-> Profile
-> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
aggregateCallSitesOrderBy CallSite AggregatedCostCentre
-> (Scientific, (Scientific, (Scientific, Scientific)))
sortKey
  where
    sortKey :: CallSite AggregatedCostCentre
-> (Scientific, (Scientific, (Scientific, Scientific)))
sortKey = forall cc. CallSite cc -> Scientific
callSiteContribTime forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall cc. CallSite cc -> Scientific
callSiteContribAlloc
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AggregatedCostCentre -> Scientific
aggregatedCostCentreTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cc. CallSite cc -> cc
callSiteCostCentre
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AggregatedCostCentre -> Scientific
aggregatedCostCentreAlloc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cc. CallSite cc -> cc
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 AggregatedCostCentre -> a)
  -- ^ Sorting key function
  -> Text
  -- ^ Cost centre name
  -> Text
  -- ^ Module name
  -> Profile
  -> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
aggregateCallSitesOrderBy :: forall a.
Ord a =>
(CallSite AggregatedCostCentre -> a)
-> Text
-> Text
-> Profile
-> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
aggregateCallSitesOrderBy CallSite AggregatedCostCentre -> a
sortKey Text
name Text
modName =
  forall a.
Ord a =>
(CallSite AggregatedCostCentre -> a)
-> Text
-> Text
-> CostCentreTree
-> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
buildAggregateCallSitesOrderBy CallSite AggregatedCostCentre -> a
sortKey Text
name Text
modName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> CostCentreTree
profileCostCentreTree

-- | Build a list of call-sites (caller functions) for a specified
-- cost-centre name and module name.
callSites
  :: Text
  -- ^ Cost-centre name
  -> Text
  -- ^ Module name
  -> Profile
  -> Maybe (AggregatedCostCentre, [CallSite CostCentre])
callSites :: Text
-> Text
-> Profile
-> Maybe (AggregatedCostCentre, [CallSite CostCentre])
callSites = forall a.
Ord a =>
(CallSite CostCentre -> a)
-> Text
-> Text
-> Profile
-> Maybe (AggregatedCostCentre, [CallSite CostCentre])
callSitesOrderBy CallSite CostCentre
-> (Scientific, (Scientific, (Scientific, Scientific)))
sortKey
  where
    sortKey :: CallSite CostCentre
-> (Scientific, (Scientific, (Scientific, Scientific)))
sortKey = forall cc. CallSite cc -> Scientific
callSiteContribTime forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall cc. CallSite cc -> Scientific
callSiteContribAlloc
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CostCentre -> Scientific
costCentreIndTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cc. CallSite cc -> cc
callSiteCostCentre
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CostCentre -> Scientific
costCentreIndAlloc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cc. CallSite cc -> cc
callSiteCostCentre

-- | Build a list of call-sites (caller function) for a specified
-- cost-centre name and module name. Nodes are sorted by the given
-- key function.
callSitesOrderBy
  :: Ord a
  => (CallSite CostCentre -> a)
  -- ^ Sorting key function
  -> Text
  -- ^ Cost-centre name
  -> Text
  -- ^ Module name
  -> Profile
  -> Maybe (AggregatedCostCentre, [CallSite CostCentre])
callSitesOrderBy :: forall a.
Ord a =>
(CallSite CostCentre -> a)
-> Text
-> Text
-> Profile
-> Maybe (AggregatedCostCentre, [CallSite CostCentre])
callSitesOrderBy CallSite CostCentre -> a
sortKey Text
name Text
modName =
  forall a.
Ord a =>
(CallSite CostCentre -> a)
-> Text
-> Text
-> CostCentreTree
-> Maybe (AggregatedCostCentre, [CallSite CostCentre])
buildCallSitesOrderBy CallSite CostCentre -> a
sortKey Text
name Text
modName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> CostCentreTree
profileCostCentreTree

-- | Break down aggregate cost centres by module sorted by total time and
-- allocation.
aggregateModules
  :: Profile
  -> [AggregateModule]
aggregateModules :: Profile -> [AggregateModule]
aggregateModules = forall a.
Ord a =>
(AggregateModule -> a) -> Profile -> [AggregateModule]
aggregateModulesOrderBy AggregateModule -> (Scientific, Scientific)
sortKey
  where
    sortKey :: AggregateModule -> (Scientific, Scientific)
sortKey = AggregateModule -> Scientific
aggregateModuleTime forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AggregateModule -> Scientific
aggregateModuleAlloc

-- | Break odwn aggregate cost centres by module.
aggregateModulesOrderBy
  :: Ord a
  => (AggregateModule -> a) -- ^ Sorting key function
  -> Profile
  -> [AggregateModule]
aggregateModulesOrderBy :: forall a.
Ord a =>
(AggregateModule -> a) -> Profile -> [AggregateModule]
aggregateModulesOrderBy AggregateModule -> a
sortKey =
    forall a.
Ord a =>
(AggregateModule -> a) -> CostCentreTree -> [AggregateModule]
buildAggregateModulesOrderBy AggregateModule -> a
sortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> CostCentreTree
profileCostCentreTree

-----------------------------------------------------------

buildAggregatedCostCentresOrderBy
  :: Ord a
  => (AggregatedCostCentre -> a)
  -> CostCentreTree
  -> [AggregatedCostCentre]
buildAggregatedCostCentresOrderBy :: forall a.
Ord a =>
(AggregatedCostCentre -> a)
-> CostCentreTree -> [AggregatedCostCentre]
buildAggregatedCostCentresOrderBy AggregatedCostCentre -> a
sortKey CostCentreTree {IntMap CostCentreNo
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap CostCentreNo
costCentreNodes :: CostCentreTree -> IntMap CostCentre
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap CostCentreNo
costCentreNodes :: IntMap CostCentre
..} =
  forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AggregatedCostCentre -> a
sortKey) forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Map Text (Map Text AggregatedCostCentre)
costCentreAggregate

buildCostCentresOrderBy
  :: Ord a
  => (CostCentre -> a)
  -- ^ Sorting key function
  -> CostCentreTree
  -> Maybe (Tree CostCentre)
buildCostCentresOrderBy :: forall a.
Ord a =>
(CostCentre -> a) -> CostCentreTree -> Maybe (Tree CostCentre)
buildCostCentresOrderBy CostCentre -> a
sortKey CostCentreTree {IntMap CostCentreNo
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap CostCentreNo
costCentreNodes :: IntMap CostCentre
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap CostCentreNo
costCentreNodes :: CostCentreTree -> IntMap CostCentre
..} = do
  -- Invariant:
  --   The root node (MAIN.MAIN) should have the least cost centre ID
  CostCentreNo
rootKey <- forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [CostCentreNo]
IntMap.keys IntMap CostCentre
costCentreNodes
  forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> b -> m (Tree a)
Tree.unfoldTreeM CostCentreNo -> Maybe (CostCentre, [CostCentreNo])
build CostCentreNo
rootKey
  where
    build :: CostCentreNo -> Maybe (CostCentre, [CostCentreNo])
build CostCentreNo
key = do
      CostCentre
node <- forall a. CostCentreNo -> IntMap a -> Maybe a
IntMap.lookup CostCentreNo
key IntMap CostCentre
costCentreNodes
      forall (m :: * -> *) a. Monad m => a -> m a
return (CostCentre
node, [CostCentreNo]
children)
      where
          !children :: [CostCentreNo]
children = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList forall a b. (a -> b) -> a -> b
$ do
            Set CostCentre
nodes <- forall a. CostCentreNo -> IntMap a -> Maybe a
IntMap.lookup CostCentreNo
key IntMap (Set CostCentre)
costCentreChildren
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CostCentre -> CostCentreNo
costCentreNo
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CostCentre -> a
sortKey) (forall a. Set a -> [a]
Set.toList Set CostCentre
nodes)

buildAggregateCallSitesOrderBy
  :: Ord a
  => (CallSite AggregatedCostCentre -> a)
  -- ^ Sorting key function
  -> Text
  -- ^ Cost centre name
  -> Text
  -- ^ Module name
  -> CostCentreTree
  -> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
buildAggregateCallSitesOrderBy :: forall a.
Ord a =>
(CallSite AggregatedCostCentre -> a)
-> Text
-> Text
-> CostCentreTree
-> Maybe (AggregatedCostCentre, [CallSite AggregatedCostCentre])
buildAggregateCallSitesOrderBy CallSite AggregatedCostCentre -> a
sortKey Text
name Text
modName tree :: CostCentreTree
tree@CostCentreTree {IntMap CostCentreNo
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap CostCentreNo
costCentreNodes :: IntMap CostCentre
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap CostCentreNo
costCentreNodes :: CostCentreTree -> IntMap CostCentre
..} =
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AggregatedCostCentre
callee forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [CallSite AggregatedCostCentre]
callers
  where
    callee :: Maybe AggregatedCostCentre
callee = Text
-> Text
-> Map Text (Map Text AggregatedCostCentre)
-> Maybe AggregatedCostCentre
lookupAggregate Text
name Text
modName Map Text (Map Text AggregatedCostCentre)
costCentreAggregate
    callers :: Maybe [CallSite AggregatedCostCentre]
callers = do
      Set CostCentre
callees <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
name, Text
modName) Map (Text, Text) (Set CostCentre)
costCentreCallSites
      forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CallSite AggregatedCostCentre -> a
sortKey) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CostCentreTree
-> Map (Text, Text) (CallSite AggregatedCostCentre)
-> CostCentre
-> Maybe (Map (Text, Text) (CallSite AggregatedCostCentre))
buildAggregateCallSite CostCentreTree
tree) forall k a. Map k a
Map.empty (forall a. Set a -> [a]
Set.toList Set CostCentre
callees)

buildAggregateCallSite
  :: CostCentreTree
  -> Map.Map (Text, Text) (CallSite AggregatedCostCentre)
  -> CostCentre
  -> Maybe (Map.Map (Text, Text) (CallSite AggregatedCostCentre))
buildAggregateCallSite :: CostCentreTree
-> Map (Text, Text) (CallSite AggregatedCostCentre)
-> CostCentre
-> Maybe (Map (Text, Text) (CallSite AggregatedCostCentre))
buildAggregateCallSite CostCentreTree {IntMap CostCentreNo
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap CostCentreNo
costCentreNodes :: IntMap CostCentre
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap CostCentreNo
costCentreNodes :: CostCentreTree -> IntMap CostCentre
..} Map (Text, Text) (CallSite AggregatedCostCentre)
parents CostCentre {CostCentreNo
Integer
Maybe Integer
Maybe Text
Text
Scientific
costCentreBytes :: CostCentre -> Maybe Integer
costCentreTicks :: CostCentre -> Maybe Integer
costCentreEntries :: CostCentre -> Integer
costCentreSrc :: CostCentre -> Maybe Text
costCentreModule :: CostCentre -> Text
costCentreName :: CostCentre -> Text
costCentreBytes :: Maybe Integer
costCentreTicks :: Maybe Integer
costCentreInhAlloc :: Scientific
costCentreInhTime :: Scientific
costCentreIndAlloc :: Scientific
costCentreIndTime :: Scientific
costCentreEntries :: Integer
costCentreSrc :: Maybe Text
costCentreModule :: Text
costCentreName :: Text
costCentreNo :: CostCentreNo
costCentreNo :: CostCentre -> CostCentreNo
costCentreIndAlloc :: CostCentre -> Scientific
costCentreInhAlloc :: CostCentre -> Scientific
costCentreIndTime :: CostCentre -> Scientific
costCentreInhTime :: CostCentre -> Scientific
..} = do
  CostCentreNo
parentNo <- forall a. CostCentreNo -> IntMap a -> Maybe a
IntMap.lookup CostCentreNo
costCentreNo IntMap CostCentreNo
costCentreParents
  CostCentre
parent <- forall a. CostCentreNo -> IntMap a -> Maybe a
IntMap.lookup CostCentreNo
parentNo IntMap CostCentre
costCentreNodes
  let parentName :: Text
parentName = CostCentre -> Text
Types.costCentreName CostCentre
parent
      parentModule :: Text
parentModule = CostCentre -> Text
Types.costCentreModule CostCentre
parent
  AggregatedCostCentre
aggregate <- Text
-> Text
-> Map Text (Map Text AggregatedCostCentre)
-> Maybe AggregatedCostCentre
lookupAggregate Text
parentName Text
parentModule Map Text (Map Text AggregatedCostCentre)
costCentreAggregate
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
    forall a. CallSite a -> CallSite a -> CallSite a
mergeCallSites
    (Text
parentName, Text
parentModule)
    CallSite
      { callSiteCostCentre :: AggregatedCostCentre
callSiteCostCentre = AggregatedCostCentre
aggregate
      , callSiteContribEntries :: Integer
callSiteContribEntries = Integer
costCentreEntries
      , callSiteContribTime :: Scientific
callSiteContribTime = Scientific
costCentreIndTime
      , callSiteContribAlloc :: Scientific
callSiteContribAlloc = Scientific
costCentreIndAlloc
      , callSiteContribTicks :: Maybe Integer
callSiteContribTicks = Maybe Integer
costCentreTicks
      , callSiteContribBytes :: Maybe Integer
callSiteContribBytes = Maybe Integer
costCentreBytes
      }
    Map (Text, Text) (CallSite AggregatedCostCentre)
parents

mergeCallSites :: CallSite a -> CallSite a -> CallSite a
mergeCallSites :: forall a. CallSite a -> CallSite a -> CallSite a
mergeCallSites CallSite a
a CallSite a
b = CallSite a
a
  { callSiteContribEntries :: Integer
callSiteContribEntries = forall cc. CallSite cc -> Integer
callSiteContribEntries CallSite a
a forall a. Num a => a -> a -> a
+ forall cc. CallSite cc -> Integer
callSiteContribEntries CallSite a
b
  , callSiteContribTime :: Scientific
callSiteContribTime = forall cc. CallSite cc -> Scientific
callSiteContribTime CallSite a
a forall a. Num a => a -> a -> a
+ forall cc. CallSite cc -> Scientific
callSiteContribTime CallSite a
b
  , callSiteContribAlloc :: Scientific
callSiteContribAlloc = forall cc. CallSite cc -> Scientific
callSiteContribAlloc CallSite a
a forall a. Num a => a -> a -> a
+ forall cc. CallSite cc -> Scientific
callSiteContribAlloc CallSite a
b
  , callSiteContribTicks :: Maybe Integer
callSiteContribTicks = forall (m :: * -> *) a. Monad m => m a -> m a
seqM forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cc. CallSite cc -> Maybe Integer
callSiteContribTicks CallSite a
a
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall cc. CallSite cc -> Maybe Integer
callSiteContribTicks CallSite a
b
  , callSiteContribBytes :: Maybe Integer
callSiteContribBytes = forall (m :: * -> *) a. Monad m => m a -> m a
seqM forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cc. CallSite cc -> Maybe Integer
callSiteContribBytes CallSite a
a
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall cc. CallSite cc -> Maybe Integer
callSiteContribBytes CallSite a
b
  }

buildCallSitesOrderBy
  :: Ord a
  => (CallSite CostCentre -> a)
  -- ^ Sorting key function
  -> Text
  -- ^ Cost-centre name
  -> Text
  -- ^ Module name
  -> CostCentreTree
  -> Maybe (AggregatedCostCentre, [CallSite CostCentre])
buildCallSitesOrderBy :: forall a.
Ord a =>
(CallSite CostCentre -> a)
-> Text
-> Text
-> CostCentreTree
-> Maybe (AggregatedCostCentre, [CallSite CostCentre])
buildCallSitesOrderBy CallSite CostCentre -> a
sortKey Text
name Text
modName tree :: CostCentreTree
tree@CostCentreTree {IntMap CostCentreNo
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap CostCentreNo
costCentreNodes :: IntMap CostCentre
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap CostCentreNo
costCentreNodes :: CostCentreTree -> IntMap CostCentre
..} =
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AggregatedCostCentre
callee forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [CallSite CostCentre]
callers
  where
    callee :: Maybe AggregatedCostCentre
callee = Text
-> Text
-> Map Text (Map Text AggregatedCostCentre)
-> Maybe AggregatedCostCentre
lookupAggregate Text
name Text
modName Map Text (Map Text AggregatedCostCentre)
costCentreAggregate
    callers :: Maybe [CallSite CostCentre]
callers = do
      Set CostCentre
callees <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
name, Text
modName) Map (Text, Text) (Set CostCentre)
costCentreCallSites
      forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CallSite CostCentre -> a
sortKey)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CostCentreTree -> CostCentre -> Maybe (CallSite CostCentre)
buildCallSite CostCentreTree
tree) (forall a. Set a -> [a]
Set.toList Set CostCentre
callees)

buildCallSite
  :: CostCentreTree
  -> CostCentre
  -> Maybe (CallSite CostCentre)
buildCallSite :: CostCentreTree -> CostCentre -> Maybe (CallSite CostCentre)
buildCallSite CostCentreTree {IntMap CostCentreNo
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap CostCentreNo
costCentreNodes :: IntMap CostCentre
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap CostCentreNo
costCentreNodes :: CostCentreTree -> IntMap CostCentre
..} CostCentre {CostCentreNo
Integer
Maybe Integer
Maybe Text
Text
Scientific
costCentreBytes :: Maybe Integer
costCentreTicks :: Maybe Integer
costCentreInhAlloc :: Scientific
costCentreInhTime :: Scientific
costCentreIndAlloc :: Scientific
costCentreIndTime :: Scientific
costCentreEntries :: Integer
costCentreSrc :: Maybe Text
costCentreModule :: Text
costCentreName :: Text
costCentreNo :: CostCentreNo
costCentreBytes :: CostCentre -> Maybe Integer
costCentreTicks :: CostCentre -> Maybe Integer
costCentreEntries :: CostCentre -> Integer
costCentreSrc :: CostCentre -> Maybe Text
costCentreModule :: CostCentre -> Text
costCentreName :: CostCentre -> Text
costCentreNo :: CostCentre -> CostCentreNo
costCentreIndAlloc :: CostCentre -> Scientific
costCentreInhAlloc :: CostCentre -> Scientific
costCentreIndTime :: CostCentre -> Scientific
costCentreInhTime :: CostCentre -> Scientific
..} = do
  CostCentreNo
parentNo <- forall a. CostCentreNo -> IntMap a -> Maybe a
IntMap.lookup CostCentreNo
costCentreNo IntMap CostCentreNo
costCentreParents
  CostCentre
parent <- forall a. CostCentreNo -> IntMap a -> Maybe a
IntMap.lookup CostCentreNo
parentNo IntMap CostCentre
costCentreNodes
  forall (m :: * -> *) a. Monad m => a -> m a
return CallSite
    { callSiteCostCentre :: CostCentre
callSiteCostCentre = CostCentre
parent
    , callSiteContribEntries :: Integer
callSiteContribEntries = Integer
costCentreEntries
    , callSiteContribTime :: Scientific
callSiteContribTime = Scientific
costCentreIndTime
    , callSiteContribAlloc :: Scientific
callSiteContribAlloc = Scientific
costCentreIndAlloc
    , callSiteContribTicks :: Maybe Integer
callSiteContribTicks = Maybe Integer
costCentreTicks
    , callSiteContribBytes :: Maybe Integer
callSiteContribBytes = Maybe Integer
costCentreBytes
    }

buildAggregateModulesOrderBy
  :: Ord a
  => (AggregateModule -> a)
  -- ^ Sorting key function
  -> CostCentreTree
  -> [AggregateModule]
buildAggregateModulesOrderBy :: forall a.
Ord a =>
(AggregateModule -> a) -> CostCentreTree -> [AggregateModule]
buildAggregateModulesOrderBy AggregateModule -> a
sortKey CostCentreTree {IntMap CostCentreNo
IntMap (Set CostCentre)
IntMap CostCentre
Map (Text, Text) (Set CostCentre)
Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreChildren :: IntMap (Set CostCentre)
costCentreParents :: IntMap CostCentreNo
costCentreNodes :: IntMap CostCentre
costCentreAggregate :: CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreCallSites :: CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreChildren :: CostCentreTree -> IntMap (Set CostCentre)
costCentreParents :: CostCentreTree -> IntMap CostCentreNo
costCentreNodes :: CostCentreTree -> IntMap CostCentre
..} =
  forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AggregateModule -> a
sortKey) forall a b. (a -> b) -> a -> b
$
    forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
      (\Text
modName Map Text AggregatedCostCentre
ccs [AggregateModule]
as -> forall {k}. Text -> Map k AggregatedCostCentre -> AggregateModule
aggregateModule Text
modName Map Text AggregatedCostCentre
ccs forall a. a -> [a] -> [a]
: [AggregateModule]
as)
      []
      Map Text (Map Text AggregatedCostCentre)
costCentreAggregate
  where
    aggregateModule :: Text -> Map k AggregatedCostCentre -> AggregateModule
aggregateModule Text
modName = forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' AggregateModule -> AggregatedCostCentre -> AggregateModule
add (Text -> AggregateModule
emptyAggregateModule Text
modName)
    add :: AggregateModule -> AggregatedCostCentre -> AggregateModule
add AggregateModule
aggMod AggregatedCostCentre {Maybe Integer
Maybe Text
Text
Scientific
aggregatedCostCentreBytes :: AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreTicks :: AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreEntries :: AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreSrc :: AggregatedCostCentre -> Maybe Text
aggregatedCostCentreModule :: AggregatedCostCentre -> Text
aggregatedCostCentreName :: AggregatedCostCentre -> Text
aggregatedCostCentreBytes :: Maybe Integer
aggregatedCostCentreTicks :: Maybe Integer
aggregatedCostCentreAlloc :: Scientific
aggregatedCostCentreTime :: Scientific
aggregatedCostCentreEntries :: Maybe Integer
aggregatedCostCentreSrc :: Maybe Text
aggregatedCostCentreModule :: Text
aggregatedCostCentreName :: Text
aggregatedCostCentreAlloc :: AggregatedCostCentre -> Scientific
aggregatedCostCentreTime :: AggregatedCostCentre -> Scientific
..} = AggregateModule
aggMod
      { aggregateModuleEntries :: Maybe Integer
aggregateModuleEntries = forall (m :: * -> *) a. Monad m => m a -> m a
seqM forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AggregateModule -> Maybe Integer
aggregateModuleEntries AggregateModule
aggMod
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Integer
aggregatedCostCentreEntries
      , aggregateModuleTime :: Scientific
aggregateModuleTime =
        AggregateModule -> Scientific
aggregateModuleTime AggregateModule
aggMod forall a. Num a => a -> a -> a
+ Scientific
aggregatedCostCentreTime
      , aggregateModuleAlloc :: Scientific
aggregateModuleAlloc =
        AggregateModule -> Scientific
aggregateModuleAlloc AggregateModule
aggMod forall a. Num a => a -> a -> a
+ Scientific
aggregatedCostCentreAlloc
      , aggregateModuleTicks :: Maybe Integer
aggregateModuleTicks = forall (m :: * -> *) a. Monad m => m a -> m a
seqM forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AggregateModule -> Maybe Integer
aggregateModuleTicks AggregateModule
aggMod
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Integer
aggregatedCostCentreTicks
      , aggregateModuleBytes :: Maybe Integer
aggregateModuleBytes = forall (m :: * -> *) a. Monad m => m a -> m a
seqM forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AggregateModule -> Maybe Integer
aggregateModuleBytes AggregateModule
aggMod
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Integer
aggregatedCostCentreBytes
      }

lookupAggregate
  :: Text -- ^ Cost centre name
  -> Text -- ^ Module name
  -> Map.Map Text (Map.Map Text AggregatedCostCentre)
  -> Maybe AggregatedCostCentre
lookupAggregate :: Text
-> Text
-> Map Text (Map Text AggregatedCostCentre)
-> Maybe AggregatedCostCentre
lookupAggregate Text
name Text
modName Map Text (Map Text AggregatedCostCentre)
m = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
modName Map Text (Map Text AggregatedCostCentre)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name