ghcprofview-0.1.0.2: src/Types.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeApplications #-}

module Types where

import qualified Data.Text as T
import Data.Int
import Data.Tree
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Scientific
-- import Data.Typeable
import Data.GI.Base.GValue

type Id = Int

class IsTree t a | t -> a where
  treeRoot :: t -> a
  treeChildren :: t -> [t]

data AggregateState = Individual | Aggregated
  deriving (Eq, Show)

data RecordId (a :: AggregateState) where
  IndividualId :: Id -> RecordId Individual
  AggregatedId :: IS.IntSet -> RecordId Aggregated

instance Show (RecordId a) where
  show (IndividualId id) = show id
  show (AggregatedId set) = show set

instance IsGValue Int where
  gvalueGType_ = gvalueGType_ @Int64
  gvalueSet_ ptr v = gvalueSet_ ptr (fromIntegral v :: Int64)
  gvalueGet_ v = fromIntegral `fmap` (gvalueGet_ v :: IO Int64)

instance IsGValue Integer where
  gvalueGType_ = gvalueGType_ @Int64
  gvalueSet_ ptr v = gvalueSet_ ptr (fromIntegral v :: Int64)
  gvalueGet_ v = fromIntegral `fmap` (gvalueGet_ v :: IO Int64)

instance IsGValue Scientific where
  gvalueGType_ = gvalueGType_ @Double
  gvalueSet_ ptr v = gvalueSet_ ptr (toRealFloat v :: Double)
  gvalueGet_ v = fromFloatDigits `fmap` (gvalueGet_ v :: IO Double)

data CostCentreData = CostCentreData {
    ccdProfile :: !Profile
  , ccdParent :: Maybe CostCentreData
  , ccdRecords :: ![ProfileRecord Individual]
  , ccdCostCentre :: !CostCentre
  , ccdChildren :: ![CostCentreData]
  }
  deriving (Show)

instance IsTree CostCentreData CostCentreData where
  treeRoot = id
  treeChildren = ccdChildren

data CostCentre = CostCentre {
    ccLabel :: !T.Text
  , ccId :: !Id
  , ccModule :: !T.Text
  , ccSource :: !T.Text
  , ccIsCaf :: !Bool
  }
  deriving (Eq, Show)

data ProfileRecord s = ProfileRecord {
    prCcId :: !(RecordId s)
  , prEntries :: !Integer
  , prTicks :: !(Maybe Integer)             -- ^ If present in input file
  , prAlloc :: !(Maybe Integer)             -- ^ If present in input file
  , prTimeIndividual :: !(Maybe Double) -- ^ If present in input file
  , prAllocIndividual :: !(Maybe Double) -- ^ If present in input file
  , prTimeInherited :: !(Maybe Double) -- ^ If present in input file
  , prAllocInherited :: !(Maybe Double) -- ^ If present in input file
  }
  deriving (Show)

singleRecordId :: ProfileRecord Individual -> Id
singleRecordId r@(ProfileRecord {prCcId = IndividualId id}) = id

listRecordId :: ProfileRecord a -> [Id]
listRecordId (ProfileRecord {prCcId = IndividualId id}) = [id]
listRecordId (ProfileRecord {prCcId = AggregatedId set}) = IS.toList set

data Profile = Profile {
    profileProgram :: !T.Text
  , profileTotalTime :: !Double
  , profileRtsArguments :: ![T.Text]
  , profileInitCaps :: !Int32
  , profileTickInterval :: !Int32
  , profileTotalAlloc :: !Integer
  , profileTotalTicks :: !Integer
  , profileTree :: Tree (ProfileRecord Individual)
  , profileTreeMap :: IM.IntMap (Tree (ProfileRecord Individual))
  , profileCostCentres :: IM.IntMap CostCentre
  }
  deriving (Show)

data FilterParams = FilterParams {
        fpEntries :: Integer
      , fpTimeIndividual :: Double
      , fpAllocIndividual :: Double
      , fpTimeInherited :: Double
      , fpAllocInherited :: Double
      , fpModule :: T.Text
      , fpSource :: T.Text
    }

data SearchMetohd = Contains | Exact | Regexp
  deriving (Eq, Show, Read, Enum, Bounded)