{-# LANGUAGE RecordWildCards #-}
module GHC.Prof.Types where
import Data.Monoid
import Prelude

import Data.IntMap (IntMap)
import Data.Map (Map)
import Data.Scientific (Scientific)
import Data.Set (Set)
import Data.Text (Text)
import Data.Time (DiffTime, LocalTime)

-- | Top-level profiling report
data Profile = Profile
  { Profile -> LocalTime
profileTimestamp :: !LocalTime
  , Profile -> Text
profileCommandLine :: !Text
  , Profile -> TotalTime
profileTotalTime :: !TotalTime
  , Profile -> TotalAlloc
profileTotalAlloc :: !TotalAlloc
  , Profile -> [AggregatedCostCentre]
profileTopCostCentres :: [AggregatedCostCentre]
  , Profile -> CostCentreTree
profileCostCentreTree :: !CostCentreTree
  } deriving Int -> Profile -> ShowS
[Profile] -> ShowS
Profile -> String
(Int -> Profile -> ShowS)
-> (Profile -> String) -> ([Profile] -> ShowS) -> Show Profile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Profile] -> ShowS
$cshowList :: [Profile] -> ShowS
show :: Profile -> String
$cshow :: Profile -> String
showsPrec :: Int -> Profile -> ShowS
$cshowsPrec :: Int -> Profile -> ShowS
Show

-- | @total time@ in the profiling reports
data TotalTime = TotalTime
  { TotalTime -> DiffTime
totalTimeElapsed :: !DiffTime
  -- ^ Total elapsed time in seconds
  , TotalTime -> Integer
totalTimeTicks :: !Integer
  -- ^ Total number of ticks
  , TotalTime -> DiffTime
totalTimeResolution :: !DiffTime
  -- ^ Duration of a tick
  , TotalTime -> Maybe Int
totalTimeProcessors :: !(Maybe Int)
  -- ^ Number of processors
  } deriving Int -> TotalTime -> ShowS
[TotalTime] -> ShowS
TotalTime -> String
(Int -> TotalTime -> ShowS)
-> (TotalTime -> String)
-> ([TotalTime] -> ShowS)
-> Show TotalTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TotalTime] -> ShowS
$cshowList :: [TotalTime] -> ShowS
show :: TotalTime -> String
$cshow :: TotalTime -> String
showsPrec :: Int -> TotalTime -> ShowS
$cshowsPrec :: Int -> TotalTime -> ShowS
Show

-- | @total alloc@ in the profiling reports
newtype TotalAlloc = TotalAlloc
  { TotalAlloc -> Integer
totalAllocBytes :: Integer
  -- ^ Total memory allocation in bytes
  } deriving Int -> TotalAlloc -> ShowS
[TotalAlloc] -> ShowS
TotalAlloc -> String
(Int -> TotalAlloc -> ShowS)
-> (TotalAlloc -> String)
-> ([TotalAlloc] -> ShowS)
-> Show TotalAlloc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TotalAlloc] -> ShowS
$cshowList :: [TotalAlloc] -> ShowS
show :: TotalAlloc -> String
$cshow :: TotalAlloc -> String
showsPrec :: Int -> TotalAlloc -> ShowS
$cshowsPrec :: Int -> TotalAlloc -> ShowS
Show

data AggregatedCostCentre = AggregatedCostCentre
  { AggregatedCostCentre -> Text
aggregatedCostCentreName :: !Text
  -- ^ Name of the cost-centre
  , AggregatedCostCentre -> Text
aggregatedCostCentreModule :: !Text
  -- ^ Module name of the cost-centre
  , AggregatedCostCentre -> Maybe Text
aggregatedCostCentreSrc :: !(Maybe Text)
  -- ^ Source location of the cost-centre
  , AggregatedCostCentre -> Maybe Integer
aggregatedCostCentreEntries :: !(Maybe Integer)
  -- ^ Number of entries to the cost-centre
  , AggregatedCostCentre -> Scientific
aggregatedCostCentreTime :: !Scientific
  -- ^ Total time spent in the cost-centre
  , AggregatedCostCentre -> Scientific
aggregatedCostCentreAlloc :: !Scientific
  -- ^ Total allocation in the cost-centre
  , AggregatedCostCentre -> 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.
  , AggregatedCostCentre -> 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 (Int -> AggregatedCostCentre -> ShowS
[AggregatedCostCentre] -> ShowS
AggregatedCostCentre -> String
(Int -> AggregatedCostCentre -> ShowS)
-> (AggregatedCostCentre -> String)
-> ([AggregatedCostCentre] -> ShowS)
-> Show AggregatedCostCentre
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregatedCostCentre] -> ShowS
$cshowList :: [AggregatedCostCentre] -> ShowS
show :: AggregatedCostCentre -> String
$cshow :: AggregatedCostCentre -> String
showsPrec :: Int -> AggregatedCostCentre -> ShowS
$cshowsPrec :: Int -> AggregatedCostCentre -> ShowS
Show, AggregatedCostCentre -> AggregatedCostCentre -> Bool
(AggregatedCostCentre -> AggregatedCostCentre -> Bool)
-> (AggregatedCostCentre -> AggregatedCostCentre -> Bool)
-> Eq AggregatedCostCentre
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
$c/= :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
== :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
$c== :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
Eq, Eq AggregatedCostCentre
Eq AggregatedCostCentre
-> (AggregatedCostCentre -> AggregatedCostCentre -> Ordering)
-> (AggregatedCostCentre -> AggregatedCostCentre -> Bool)
-> (AggregatedCostCentre -> AggregatedCostCentre -> Bool)
-> (AggregatedCostCentre -> AggregatedCostCentre -> Bool)
-> (AggregatedCostCentre -> AggregatedCostCentre -> Bool)
-> (AggregatedCostCentre
    -> AggregatedCostCentre -> AggregatedCostCentre)
-> (AggregatedCostCentre
    -> AggregatedCostCentre -> AggregatedCostCentre)
-> Ord AggregatedCostCentre
AggregatedCostCentre -> AggregatedCostCentre -> Bool
AggregatedCostCentre -> AggregatedCostCentre -> Ordering
AggregatedCostCentre
-> AggregatedCostCentre -> AggregatedCostCentre
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AggregatedCostCentre
-> AggregatedCostCentre -> AggregatedCostCentre
$cmin :: AggregatedCostCentre
-> AggregatedCostCentre -> AggregatedCostCentre
max :: AggregatedCostCentre
-> AggregatedCostCentre -> AggregatedCostCentre
$cmax :: AggregatedCostCentre
-> AggregatedCostCentre -> AggregatedCostCentre
>= :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
$c>= :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
> :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
$c> :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
<= :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
$c<= :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
< :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
$c< :: AggregatedCostCentre -> AggregatedCostCentre -> Bool
compare :: AggregatedCostCentre -> AggregatedCostCentre -> Ordering
$ccompare :: AggregatedCostCentre -> AggregatedCostCentre -> Ordering
$cp1Ord :: Eq AggregatedCostCentre
Ord)

-- | Cost-centre node
data CostCentre = CostCentre
  { CostCentre -> Int
costCentreNo :: !CostCentreNo
  -- ^ Identifier of the cost-centre
  , CostCentre -> Text
costCentreName :: !Text
  -- ^ Name of the cost-centre
  , CostCentre -> Text
costCentreModule :: !Text
  -- ^ Module name of the cost-centre
  , CostCentre -> Maybe Text
costCentreSrc :: !(Maybe Text)
  -- ^ Source location of the cost-centre
  , CostCentre -> Integer
costCentreEntries :: !Integer
  -- ^ Number of entries to the cost-centre
  , CostCentre -> Scientific
costCentreIndTime :: !Scientific
  -- ^ Time spent in the cost-centre itself
  , CostCentre -> Scientific
costCentreIndAlloc :: !Scientific
  -- ^ Allocation incurred by the cost-centre itself
  , CostCentre -> Scientific
costCentreInhTime :: !Scientific
  -- ^ Time spent in the cost-centre's children
  , CostCentre -> Scientific
costCentreInhAlloc :: !Scientific
  -- ^ Allocation incurred by the cost-centre's children
  , CostCentre -> Maybe Integer
costCentreTicks :: !(Maybe Integer)
  -- ^ Number of ticks in the cost-centre.
  , CostCentre -> Maybe Integer
costCentreBytes :: !(Maybe Integer)
  -- ^ Number of allocated bytes in the cost-centre.
  } deriving (Int -> CostCentre -> ShowS
[CostCentre] -> ShowS
CostCentre -> String
(Int -> CostCentre -> ShowS)
-> (CostCentre -> String)
-> ([CostCentre] -> ShowS)
-> Show CostCentre
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CostCentre] -> ShowS
$cshowList :: [CostCentre] -> ShowS
show :: CostCentre -> String
$cshow :: CostCentre -> String
showsPrec :: Int -> CostCentre -> ShowS
$cshowsPrec :: Int -> CostCentre -> ShowS
Show, CostCentre -> CostCentre -> Bool
(CostCentre -> CostCentre -> Bool)
-> (CostCentre -> CostCentre -> Bool) -> Eq CostCentre
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CostCentre -> CostCentre -> Bool
$c/= :: CostCentre -> CostCentre -> Bool
== :: CostCentre -> CostCentre -> Bool
$c== :: CostCentre -> CostCentre -> Bool
Eq, Eq CostCentre
Eq CostCentre
-> (CostCentre -> CostCentre -> Ordering)
-> (CostCentre -> CostCentre -> Bool)
-> (CostCentre -> CostCentre -> Bool)
-> (CostCentre -> CostCentre -> Bool)
-> (CostCentre -> CostCentre -> Bool)
-> (CostCentre -> CostCentre -> CostCentre)
-> (CostCentre -> CostCentre -> CostCentre)
-> Ord CostCentre
CostCentre -> CostCentre -> Bool
CostCentre -> CostCentre -> Ordering
CostCentre -> CostCentre -> CostCentre
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CostCentre -> CostCentre -> CostCentre
$cmin :: CostCentre -> CostCentre -> CostCentre
max :: CostCentre -> CostCentre -> CostCentre
$cmax :: CostCentre -> CostCentre -> CostCentre
>= :: CostCentre -> CostCentre -> Bool
$c>= :: CostCentre -> CostCentre -> Bool
> :: CostCentre -> CostCentre -> Bool
$c> :: CostCentre -> CostCentre -> Bool
<= :: CostCentre -> CostCentre -> Bool
$c<= :: CostCentre -> CostCentre -> Bool
< :: CostCentre -> CostCentre -> Bool
$c< :: CostCentre -> CostCentre -> Bool
compare :: CostCentre -> CostCentre -> Ordering
$ccompare :: CostCentre -> CostCentre -> Ordering
$cp1Ord :: Eq CostCentre
Ord)

type CostCentreNo = Int

data CostCentreTree = CostCentreTree
  { CostCentreTree -> IntMap CostCentre
costCentreNodes :: !(IntMap CostCentre)
  , CostCentreTree -> IntMap Int
costCentreParents :: !(IntMap CostCentreNo)
  , CostCentreTree -> IntMap (Set CostCentre)
costCentreChildren :: !(IntMap (Set CostCentre))
  , CostCentreTree -> Map (Text, Text) (Set CostCentre)
costCentreCallSites :: !(Map (Text, Text) (Set CostCentre))
  , CostCentreTree -> Map Text (Map Text AggregatedCostCentre)
costCentreAggregate :: !(Map Text (Map Text AggregatedCostCentre))
  } deriving Int -> CostCentreTree -> ShowS
[CostCentreTree] -> ShowS
CostCentreTree -> String
(Int -> CostCentreTree -> ShowS)
-> (CostCentreTree -> String)
-> ([CostCentreTree] -> ShowS)
-> Show CostCentreTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CostCentreTree] -> ShowS
$cshowList :: [CostCentreTree] -> ShowS
show :: CostCentreTree -> String
$cshow :: CostCentreTree -> String
showsPrec :: Int -> CostCentreTree -> ShowS
$cshowsPrec :: Int -> CostCentreTree -> ShowS
Show

emptyCostCentreTree :: CostCentreTree
emptyCostCentreTree :: CostCentreTree
emptyCostCentreTree = CostCentreTree :: IntMap CostCentre
-> IntMap Int
-> IntMap (Set CostCentre)
-> Map (Text, Text) (Set CostCentre)
-> Map Text (Map Text AggregatedCostCentre)
-> CostCentreTree
CostCentreTree
  { costCentreNodes :: IntMap CostCentre
costCentreNodes = IntMap CostCentre
forall a. Monoid a => a
mempty
  , costCentreParents :: IntMap Int
costCentreParents = IntMap Int
forall a. Monoid a => a
mempty
  , costCentreChildren :: IntMap (Set CostCentre)
costCentreChildren = IntMap (Set CostCentre)
forall a. Monoid a => a
mempty
  , costCentreCallSites :: Map (Text, Text) (Set CostCentre)
costCentreCallSites = Map (Text, Text) (Set CostCentre)
forall a. Monoid a => a
mempty
  , costCentreAggregate :: Map Text (Map Text AggregatedCostCentre)
costCentreAggregate = Map Text (Map Text AggregatedCostCentre)
forall a. Monoid a => a
mempty
  }

data CallSite cc = CallSite
  { CallSite cc -> cc
callSiteCostCentre :: cc
  -- ^ Metrics for the caller function
  , CallSite cc -> Integer
callSiteContribEntries :: !Integer
  -- ^ Number of entries contriubted by the caller function
  , CallSite cc -> Scientific
callSiteContribTime :: !Scientific
  -- ^ Time contributed by the caller function
  , CallSite cc -> Scientific
callSiteContribAlloc :: !Scientific
  -- ^ Allocation contributed by the caller function
  , CallSite cc -> Maybe Integer
callSiteContribTicks :: !(Maybe Integer)
  -- ^ Number of tikcs contributed by the caller function
  , CallSite cc -> Maybe Integer
callSiteContribBytes :: !(Maybe Integer)
  -- ^ Number of allocated bytes contributed byt hte caller function
  } deriving Int -> CallSite cc -> ShowS
[CallSite cc] -> ShowS
CallSite cc -> String
(Int -> CallSite cc -> ShowS)
-> (CallSite cc -> String)
-> ([CallSite cc] -> ShowS)
-> Show (CallSite cc)
forall cc. Show cc => Int -> CallSite cc -> ShowS
forall cc. Show cc => [CallSite cc] -> ShowS
forall cc. Show cc => CallSite cc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallSite cc] -> ShowS
$cshowList :: forall cc. Show cc => [CallSite cc] -> ShowS
show :: CallSite cc -> String
$cshow :: forall cc. Show cc => CallSite cc -> String
showsPrec :: Int -> CallSite cc -> ShowS
$cshowsPrec :: forall cc. Show cc => Int -> CallSite cc -> ShowS
Show

data AggregateModule = AggregateModule
  { AggregateModule -> Text
aggregateModuleName :: !Text
  -- ^ Name of the module
  , AggregateModule -> Maybe Integer
aggregateModuleEntries :: !(Maybe Integer)
  -- ^ Total number of entries to cost centres in the module
  , AggregateModule -> Scientific
aggregateModuleTime :: !Scientific
  -- ^ Total time spent on cost centres in the module
  , AggregateModule -> Scientific
aggregateModuleAlloc :: !Scientific
  -- ^ Total allocation on cost centres in the module
  , AggregateModule -> Maybe Integer
aggregateModuleTicks :: !(Maybe Integer)
  -- ^ Total ticks on cost centres in the module. This number exists only if
  -- @-P@ or @-Pa@ option is given at run-time.
  , AggregateModule -> Maybe Integer
aggregateModuleBytes :: !(Maybe Integer)
  -- ^ Total memory allocation on cost centres in the module. This number
  -- exists only if @-P@ or @-Pa@ option is given at run-time.
  } deriving (Int -> AggregateModule -> ShowS
[AggregateModule] -> ShowS
AggregateModule -> String
(Int -> AggregateModule -> ShowS)
-> (AggregateModule -> String)
-> ([AggregateModule] -> ShowS)
-> Show AggregateModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregateModule] -> ShowS
$cshowList :: [AggregateModule] -> ShowS
show :: AggregateModule -> String
$cshow :: AggregateModule -> String
showsPrec :: Int -> AggregateModule -> ShowS
$cshowsPrec :: Int -> AggregateModule -> ShowS
Show, AggregateModule -> AggregateModule -> Bool
(AggregateModule -> AggregateModule -> Bool)
-> (AggregateModule -> AggregateModule -> Bool)
-> Eq AggregateModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggregateModule -> AggregateModule -> Bool
$c/= :: AggregateModule -> AggregateModule -> Bool
== :: AggregateModule -> AggregateModule -> Bool
$c== :: AggregateModule -> AggregateModule -> Bool
Eq, Eq AggregateModule
Eq AggregateModule
-> (AggregateModule -> AggregateModule -> Ordering)
-> (AggregateModule -> AggregateModule -> Bool)
-> (AggregateModule -> AggregateModule -> Bool)
-> (AggregateModule -> AggregateModule -> Bool)
-> (AggregateModule -> AggregateModule -> Bool)
-> (AggregateModule -> AggregateModule -> AggregateModule)
-> (AggregateModule -> AggregateModule -> AggregateModule)
-> Ord AggregateModule
AggregateModule -> AggregateModule -> Bool
AggregateModule -> AggregateModule -> Ordering
AggregateModule -> AggregateModule -> AggregateModule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AggregateModule -> AggregateModule -> AggregateModule
$cmin :: AggregateModule -> AggregateModule -> AggregateModule
max :: AggregateModule -> AggregateModule -> AggregateModule
$cmax :: AggregateModule -> AggregateModule -> AggregateModule
>= :: AggregateModule -> AggregateModule -> Bool
$c>= :: AggregateModule -> AggregateModule -> Bool
> :: AggregateModule -> AggregateModule -> Bool
$c> :: AggregateModule -> AggregateModule -> Bool
<= :: AggregateModule -> AggregateModule -> Bool
$c<= :: AggregateModule -> AggregateModule -> Bool
< :: AggregateModule -> AggregateModule -> Bool
$c< :: AggregateModule -> AggregateModule -> Bool
compare :: AggregateModule -> AggregateModule -> Ordering
$ccompare :: AggregateModule -> AggregateModule -> Ordering
$cp1Ord :: Eq AggregateModule
Ord)

emptyAggregateModule :: Text -> AggregateModule
emptyAggregateModule :: Text -> AggregateModule
emptyAggregateModule Text
name = AggregateModule :: Text
-> Maybe Integer
-> Scientific
-> Scientific
-> Maybe Integer
-> Maybe Integer
-> AggregateModule
AggregateModule
  { aggregateModuleName :: Text
aggregateModuleName = Text
name
  , aggregateModuleEntries :: Maybe Integer
aggregateModuleEntries = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
  , aggregateModuleTime :: Scientific
aggregateModuleTime = Scientific
0
  , aggregateModuleAlloc :: Scientific
aggregateModuleAlloc = Scientific
0
  , aggregateModuleTicks :: Maybe Integer
aggregateModuleTicks = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
  , aggregateModuleBytes :: Maybe Integer
aggregateModuleBytes = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
  }