{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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

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
(Int -> Header -> ShowS)
-> (Header -> FilePath) -> ([Header] -> ShowS) -> Show Header
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
(Int -> Bucket -> ShowS)
-> (Bucket -> FilePath) -> ([Bucket] -> ShowS) -> Show Bucket
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
Eq Bucket
-> (Bucket -> Bucket -> Ordering)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> Bucket)
-> Ord 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
$cp1Ord :: Eq Bucket
Ord, Bucket -> Bucket -> Bool
(Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool) -> Eq Bucket
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
(Bucket -> Value)
-> (Bucket -> Encoding)
-> ([Bucket] -> Value)
-> ([Bucket] -> Encoding)
-> ToJSON Bucket
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, Int -> Bucket -> Int
Bucket -> Int
(Int -> Bucket -> Int) -> (Bucket -> Int) -> Hashable Bucket
forall 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
(Int -> BucketInfo -> ShowS)
-> (BucketInfo -> FilePath)
-> ([BucketInfo] -> ShowS)
-> Show BucketInfo
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
(Int -> CostCentre -> ShowS)
-> (CostCentre -> FilePath)
-> ([CostCentre] -> ShowS)
-> Show CostCentre
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
(Int -> Sample -> ShowS)
-> (Sample -> FilePath) -> ([Sample] -> ShowS) -> Show Sample
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
(Int -> HeapSample -> ShowS)
-> (HeapSample -> FilePath)
-> ([HeapSample] -> ShowS)
-> Show HeapSample
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
(Int -> Frame -> ShowS)
-> (Frame -> FilePath) -> ([Frame] -> ShowS) -> Show Frame
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
(Int -> Trace -> ShowS)
-> (Trace -> FilePath) -> ([Trace] -> ShowS) -> Show Trace
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
(Int -> HeapInfo -> ShowS)
-> (HeapInfo -> FilePath) -> ([HeapInfo] -> ShowS) -> Show HeapInfo
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 } deriving Int -> ProfData -> ShowS
[ProfData] -> ShowS
ProfData -> FilePath
(Int -> ProfData -> ShowS)
-> (ProfData -> FilePath) -> ([ProfData] -> ShowS) -> Show ProfData
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

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
(Int -> InfoTableLoc -> ShowS)
-> (InfoTableLoc -> FilePath)
-> ([InfoTableLoc] -> ShowS)
-> Show InfoTableLoc
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
(InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool) -> Eq InfoTablePtr
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
Eq InfoTablePtr
-> (InfoTablePtr -> InfoTablePtr -> Ordering)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> InfoTablePtr)
-> (InfoTablePtr -> InfoTablePtr -> InfoTablePtr)
-> Ord 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
$cp1Ord :: Eq InfoTablePtr
Ord)

instance Show InfoTablePtr where
  show :: InfoTablePtr -> FilePath
show (InfoTablePtr Word64
p) =  FilePath
"0x" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> ShowS
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 = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 (Text -> FilePath
T.unpack Text
t)
        w64 :: Word64
w64 = case ReadS Word64
forall a. (Eq a, Num a) => ReadS a
readHex FilePath
s of
                ((Word64
n, FilePath
""):[(Word64, FilePath)]
_) -> Word64
n
                [(Word64, FilePath)]
_ -> FilePath -> Word64
forall a. HasCallStack => FilePath -> a
error (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
t)
    in Word64 -> InfoTablePtr
InfoTablePtr Word64
w64