{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Eventlog.Types(module Eventlog.Types, HeapProfBreakdown(..), ClosureType) where

import Data.Text (Text)
import Data.Map (Map)
import Data.Aeson
import Data.Hashable
import Data.Word
import GHC.RTS.Events (HeapProfBreakdown(..))
import GHC.Exts.Heap.ClosureTypes
import Numeric
import qualified Data.Text as T
import qualified Data.Map as Map

data Header =
  Header
  { Header -> Text
hJob         :: Text
  , Header -> Text
hDate        :: Text
  , Header -> Maybe HeapProfBreakdown
hHeapProfileType :: Maybe HeapProfBreakdown
  , Header -> Text
hSamplingRate :: Text
  , Header -> Text
hSampleUnit  :: Text
  , Header -> Text
hValueUnit   :: Text
  , Header -> Int
hCount       :: Int
  , Header -> Maybe FilePath
hProgPath    :: Maybe FilePath
  } deriving Int -> Header -> ShowS
[Header] -> ShowS
Header -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> FilePath
$cshow :: Header -> FilePath
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show


-- The bucket is a key to uniquely identify a band
newtype Bucket = Bucket Text
                  deriving (Int -> Bucket -> ShowS
[Bucket] -> ShowS
Bucket -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Bucket] -> ShowS
$cshowList :: [Bucket] -> ShowS
show :: Bucket -> FilePath
$cshow :: Bucket -> FilePath
showsPrec :: Int -> Bucket -> ShowS
$cshowsPrec :: Int -> Bucket -> ShowS
Show, Eq Bucket
Bucket -> Bucket -> Bool
Bucket -> Bucket -> Ordering
Bucket -> Bucket -> Bucket
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 :: Bucket -> Bucket -> Bucket
$cmin :: Bucket -> Bucket -> Bucket
max :: Bucket -> Bucket -> Bucket
$cmax :: Bucket -> Bucket -> Bucket
>= :: Bucket -> Bucket -> Bool
$c>= :: Bucket -> Bucket -> Bool
> :: Bucket -> Bucket -> Bool
$c> :: Bucket -> Bucket -> Bool
<= :: Bucket -> Bucket -> Bool
$c<= :: Bucket -> Bucket -> Bool
< :: Bucket -> Bucket -> Bool
$c< :: Bucket -> Bucket -> Bool
compare :: Bucket -> Bucket -> Ordering
$ccompare :: Bucket -> Bucket -> Ordering
Ord, Bucket -> Bucket -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bucket -> Bucket -> Bool
$c/= :: Bucket -> Bucket -> Bool
== :: Bucket -> Bucket -> Bool
$c== :: Bucket -> Bucket -> Bool
Eq)
                  deriving newtype ([Bucket] -> Encoding
[Bucket] -> Value
Bucket -> Encoding
Bucket -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Bucket] -> Encoding
$ctoEncodingList :: [Bucket] -> Encoding
toJSONList :: [Bucket] -> Value
$ctoJSONList :: [Bucket] -> Value
toEncoding :: Bucket -> Encoding
$ctoEncoding :: Bucket -> Encoding
toJSON :: Bucket -> Value
$ctoJSON :: Bucket -> Value
ToJSON, Eq Bucket
Int -> Bucket -> Int
Bucket -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Bucket -> Int
$chash :: Bucket -> Int
hashWithSalt :: Int -> Bucket -> Int
$chashWithSalt :: Int -> Bucket -> Int
Hashable)


data BucketInfo = BucketInfo { BucketInfo -> Text
shortDescription :: Text -- For the legend and hover
                             , BucketInfo -> Maybe [Word32]
longDescription :: Maybe [Word32]
                             , BucketInfo -> Double
bucketTotal :: Double
                             , BucketInfo -> Double
bucketStddev :: Double
                             , BucketInfo -> Maybe (Double, Double, Double)
bucketGradient :: !(Maybe (Double, Double, Double))
                             } deriving Int -> BucketInfo -> ShowS
[BucketInfo] -> ShowS
BucketInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BucketInfo] -> ShowS
$cshowList :: [BucketInfo] -> ShowS
show :: BucketInfo -> FilePath
$cshow :: BucketInfo -> FilePath
showsPrec :: Int -> BucketInfo -> ShowS
$cshowsPrec :: Int -> BucketInfo -> ShowS
Show

data CostCentre = CC { CostCentre -> Word32
cid :: Word32
                     , CostCentre -> Text
label :: Text
                     , CostCentre -> Text
modul :: Text
                     , CostCentre -> Text
loc :: Text } deriving Int -> CostCentre -> ShowS
[CostCentre] -> ShowS
CostCentre -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CostCentre] -> ShowS
$cshowList :: [CostCentre] -> ShowS
show :: CostCentre -> FilePath
$cshow :: CostCentre -> FilePath
showsPrec :: Int -> CostCentre -> ShowS
$cshowsPrec :: Int -> CostCentre -> ShowS
Show

data Sample = Sample Bucket Double deriving Int -> Sample -> ShowS
[Sample] -> ShowS
Sample -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Sample] -> ShowS
$cshowList :: [Sample] -> ShowS
show :: Sample -> FilePath
$cshow :: Sample -> FilePath
showsPrec :: Int -> Sample -> ShowS
$cshowsPrec :: Int -> Sample -> ShowS
Show

data HeapSample = HeapSample Double Word64 deriving Int -> HeapSample -> ShowS
[HeapSample] -> ShowS
HeapSample -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HeapSample] -> ShowS
$cshowList :: [HeapSample] -> ShowS
show :: HeapSample -> FilePath
$cshow :: HeapSample -> FilePath
showsPrec :: Int -> HeapSample -> ShowS
$cshowsPrec :: Int -> HeapSample -> ShowS
Show

data Frame = Frame Double [Sample] deriving Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> FilePath
$cshow :: Frame -> FilePath
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show

-- | A trace we also want to show on the graph
data Trace = Trace Double Text deriving Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> FilePath
$cshow :: Trace -> FilePath
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show

data HeapInfo = HeapInfo { HeapInfo -> [HeapSample]
heapSizeSamples :: [HeapSample]
                         , HeapInfo -> [HeapSample]
blocksSizeSamples :: [HeapSample]
                         , HeapInfo -> [HeapSample]
liveBytesSamples :: [HeapSample]
                         } deriving Int -> HeapInfo -> ShowS
[HeapInfo] -> ShowS
HeapInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HeapInfo] -> ShowS
$cshowList :: [HeapInfo] -> ShowS
show :: HeapInfo -> FilePath
$cshow :: HeapInfo -> FilePath
showsPrec :: Int -> HeapInfo -> ShowS
$cshowsPrec :: Int -> HeapInfo -> ShowS
Show

data ProfData = ProfData { ProfData -> Header
profHeader :: Header
                         , ProfData -> Map Bucket BucketInfo
profTotals :: Map Bucket BucketInfo
                         , ProfData -> Map Word32 CostCentre
profCCMap  :: Map Word32 CostCentre
                         , ProfData -> [Frame]
profFrames :: [Frame]
                         , ProfData -> [Trace]
profTraces :: [Trace]
                         , ProfData -> HeapInfo
profHeap   :: HeapInfo
                         , ProfData -> Map InfoTablePtr InfoTableLoc
profItl    :: Map InfoTablePtr InfoTableLoc
                         , ProfData -> Map TickyCounterId TickyCounter
profTickyCounters :: Map TickyCounterId TickyCounter
                         , ProfData -> [TickySample]
profTickySamples  :: [TickySample]
                         , ProfData -> Word64
profTotalAllocations :: Word64
                         } deriving Int -> ProfData -> ShowS
[ProfData] -> ShowS
ProfData -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProfData] -> ShowS
$cshowList :: [ProfData] -> ShowS
show :: ProfData -> FilePath
$cshow :: ProfData -> FilePath
showsPrec :: Int -> ProfData -> ShowS
$cshowsPrec :: Int -> ProfData -> ShowS
Show

newtype TickyCounterId = TickyCounterId Word64 deriving (Eq TickyCounterId
TickyCounterId -> TickyCounterId -> Bool
TickyCounterId -> TickyCounterId -> Ordering
TickyCounterId -> TickyCounterId -> TickyCounterId
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 :: TickyCounterId -> TickyCounterId -> TickyCounterId
$cmin :: TickyCounterId -> TickyCounterId -> TickyCounterId
max :: TickyCounterId -> TickyCounterId -> TickyCounterId
$cmax :: TickyCounterId -> TickyCounterId -> TickyCounterId
>= :: TickyCounterId -> TickyCounterId -> Bool
$c>= :: TickyCounterId -> TickyCounterId -> Bool
> :: TickyCounterId -> TickyCounterId -> Bool
$c> :: TickyCounterId -> TickyCounterId -> Bool
<= :: TickyCounterId -> TickyCounterId -> Bool
$c<= :: TickyCounterId -> TickyCounterId -> Bool
< :: TickyCounterId -> TickyCounterId -> Bool
$c< :: TickyCounterId -> TickyCounterId -> Bool
compare :: TickyCounterId -> TickyCounterId -> Ordering
$ccompare :: TickyCounterId -> TickyCounterId -> Ordering
Ord, TickyCounterId -> TickyCounterId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TickyCounterId -> TickyCounterId -> Bool
$c/= :: TickyCounterId -> TickyCounterId -> Bool
== :: TickyCounterId -> TickyCounterId -> Bool
$c== :: TickyCounterId -> TickyCounterId -> Bool
Eq, Int -> TickyCounterId -> ShowS
[TickyCounterId] -> ShowS
TickyCounterId -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TickyCounterId] -> ShowS
$cshowList :: [TickyCounterId] -> ShowS
show :: TickyCounterId -> FilePath
$cshow :: TickyCounterId -> FilePath
showsPrec :: Int -> TickyCounterId -> ShowS
$cshowsPrec :: Int -> TickyCounterId -> ShowS
Show)

data TickyCounterArgs = TickyCounterArgs { TickyCounterArgs -> Text
tickyCounterType :: Text
                                         , TickyCounterArgs -> FilePath
tickyCounterFVs  :: [Char]
                                         , TickyCounterArgs -> FilePath
tickyCounterArgs :: [Char]
                                         } deriving Int -> TickyCounterArgs -> ShowS
[TickyCounterArgs] -> ShowS
TickyCounterArgs -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TickyCounterArgs] -> ShowS
$cshowList :: [TickyCounterArgs] -> ShowS
show :: TickyCounterArgs -> FilePath
$cshow :: TickyCounterArgs -> FilePath
showsPrec :: Int -> TickyCounterArgs -> ShowS
$cshowsPrec :: Int -> TickyCounterArgs -> ShowS
Show

instance FromJSON TickyCounterArgs where
  parseJSON :: Value -> Parser TickyCounterArgs
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"TickyCounterArgs" forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> FilePath -> FilePath -> TickyCounterArgs
TickyCounterArgs
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> FilePath
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fvs")
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> FilePath
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"args")

data TickyCounter = TickyCounter { TickyCounter -> Word64
tickyCtrId :: Word64, TickyCounter -> Word16
tickyCtrArity :: Word16, TickyCounter -> TickyCounterArgs
tickyCtrArgs :: TickyCounterArgs , TickyCounter -> Text
tickyCtrName :: Text, TickyCounter -> InfoTablePtr
tickyCtrInfo :: InfoTablePtr }
  deriving Int -> TickyCounter -> ShowS
[TickyCounter] -> ShowS
TickyCounter -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TickyCounter] -> ShowS
$cshowList :: [TickyCounter] -> ShowS
show :: TickyCounter -> FilePath
$cshow :: TickyCounter -> FilePath
showsPrec :: Int -> TickyCounter -> ShowS
$cshowsPrec :: Int -> TickyCounter -> ShowS
Show

data TickySample = TickySample { TickySample -> Word64
tickyCtrSampleId, TickySample -> Word64
tickyCtrEntries, TickySample -> Word64
tickyCtrAllocs, TickySample -> Word64
tickyCtrAllocd :: Word64, TickySample -> Double
tickySampleTime :: Double }
  deriving Int -> TickySample -> ShowS
[TickySample] -> ShowS
TickySample -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TickySample] -> ShowS
$cshowList :: [TickySample] -> ShowS
show :: TickySample -> FilePath
$cshow :: TickySample -> FilePath
showsPrec :: Int -> TickySample -> ShowS
$cshowsPrec :: Int -> TickySample -> ShowS
Show

data InfoTableLoc = InfoTableLoc { InfoTableLoc -> Text
itlName :: !Text
                                 , InfoTableLoc -> ClosureType
itlClosureDesc :: !ClosureType
                                 , InfoTableLoc -> Text
itlTyDesc :: !Text
                                 , InfoTableLoc -> Text
itlLbl :: !Text
                                 , InfoTableLoc -> Text
itlModule :: !Text
                                 , InfoTableLoc -> Text
itlSrcLoc :: !Text } deriving Int -> InfoTableLoc -> ShowS
[InfoTableLoc] -> ShowS
InfoTableLoc -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InfoTableLoc] -> ShowS
$cshowList :: [InfoTableLoc] -> ShowS
show :: InfoTableLoc -> FilePath
$cshow :: InfoTableLoc -> FilePath
showsPrec :: Int -> InfoTableLoc -> ShowS
$cshowsPrec :: Int -> InfoTableLoc -> ShowS
Show

data InfoTablePtr = InfoTablePtr Word64 deriving (InfoTablePtr -> InfoTablePtr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoTablePtr -> InfoTablePtr -> Bool
$c/= :: InfoTablePtr -> InfoTablePtr -> Bool
== :: InfoTablePtr -> InfoTablePtr -> Bool
$c== :: InfoTablePtr -> InfoTablePtr -> Bool
Eq, Eq InfoTablePtr
InfoTablePtr -> InfoTablePtr -> Bool
InfoTablePtr -> InfoTablePtr -> Ordering
InfoTablePtr -> InfoTablePtr -> InfoTablePtr
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 :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
$cmin :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
max :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
$cmax :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
>= :: InfoTablePtr -> InfoTablePtr -> Bool
$c>= :: InfoTablePtr -> InfoTablePtr -> Bool
> :: InfoTablePtr -> InfoTablePtr -> Bool
$c> :: InfoTablePtr -> InfoTablePtr -> Bool
<= :: InfoTablePtr -> InfoTablePtr -> Bool
$c<= :: InfoTablePtr -> InfoTablePtr -> Bool
< :: InfoTablePtr -> InfoTablePtr -> Bool
$c< :: InfoTablePtr -> InfoTablePtr -> Bool
compare :: InfoTablePtr -> InfoTablePtr -> Ordering
$ccompare :: InfoTablePtr -> InfoTablePtr -> Ordering
Ord)

instance Show InfoTablePtr where
  show :: InfoTablePtr -> FilePath
show (InfoTablePtr Word64
p) =  FilePath
"0x" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
p FilePath
""

toItblPointer :: Bucket -> InfoTablePtr
toItblPointer :: Bucket -> InfoTablePtr
toItblPointer (Bucket Text
t) =
    let s :: FilePath
s = forall a. Int -> [a] -> [a]
drop Int
2 (Text -> FilePath
T.unpack Text
t)
        w64 :: Word64
w64 = case forall a. (Eq a, Num a) => ReadS a
readHex FilePath
s of
                ((Word64
n, FilePath
""):[(Word64, FilePath)]
_) -> Word64
n
                [(Word64, FilePath)]
_ -> forall a. HasCallStack => FilePath -> a
error (forall a. Show a => a -> FilePath
show Text
t)
    in Word64 -> InfoTablePtr
InfoTablePtr Word64
w64

data InfoTableLocStatus = None -- None of the entries have InfoTableLoc
                        | Missing -- This one is just missing
                        | Here InfoTableLoc -- Here is is

mkMissing :: Maybe InfoTableLoc -> InfoTableLocStatus
mkMissing :: Maybe InfoTableLoc -> InfoTableLocStatus
mkMissing = forall b a. b -> (a -> b) -> Maybe a -> b
maybe InfoTableLocStatus
Missing InfoTableLoc -> InfoTableLocStatus
Here


mkClosureInfo :: (k -> a -> InfoTablePtr)
              -> Map.Map k a
              -> Map.Map InfoTablePtr InfoTableLoc
              -> Map.Map k (InfoTableLocStatus, a)
mkClosureInfo :: forall k a.
(k -> a -> InfoTablePtr)
-> Map k a
-> Map InfoTablePtr InfoTableLoc
-> Map k (InfoTableLocStatus, a)
mkClosureInfo k -> a -> InfoTablePtr
f Map k a
b Map InfoTablePtr InfoTableLoc
ipes =
  forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\k
k a
v -> (Maybe InfoTableLoc -> InfoTableLocStatus
mkMissing forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k -> a -> InfoTablePtr
f k
k a
v) Map InfoTablePtr InfoTableLoc
ipes, a
v)) Map k a
b