{-# 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
import Text.Blaze.Html

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
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> FilePath
show :: Header -> FilePath
$cshowList :: [Header] -> ShowS
showList :: [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
$cshowsPrec :: Int -> Bucket -> ShowS
showsPrec :: Int -> Bucket -> ShowS
$cshow :: Bucket -> FilePath
show :: Bucket -> FilePath
$cshowList :: [Bucket] -> ShowS
showList :: [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
$ccompare :: Bucket -> Bucket -> Ordering
compare :: Bucket -> Bucket -> Ordering
$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
>= :: Bucket -> Bucket -> Bool
$cmax :: Bucket -> Bucket -> Bucket
max :: Bucket -> Bucket -> Bucket
$cmin :: Bucket -> Bucket -> Bucket
min :: Bucket -> Bucket -> Bucket
Ord, Bucket -> Bucket -> Bool
(Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool) -> Eq Bucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bucket -> Bucket -> Bool
== :: Bucket -> Bucket -> Bool
$c/= :: Bucket -> Bucket -> Bool
/= :: Bucket -> Bucket -> Bool
Eq)
                  deriving newtype ([Bucket] -> Value
[Bucket] -> Encoding
Bucket -> Bool
Bucket -> Value
Bucket -> Encoding
(Bucket -> Value)
-> (Bucket -> Encoding)
-> ([Bucket] -> Value)
-> ([Bucket] -> Encoding)
-> (Bucket -> Bool)
-> ToJSON Bucket
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Bucket -> Value
toJSON :: Bucket -> Value
$ctoEncoding :: Bucket -> Encoding
toEncoding :: Bucket -> Encoding
$ctoJSONList :: [Bucket] -> Value
toJSONList :: [Bucket] -> Value
$ctoEncodingList :: [Bucket] -> Encoding
toEncodingList :: [Bucket] -> Encoding
$comitField :: Bucket -> Bool
omitField :: Bucket -> Bool
ToJSON, Eq Bucket
Eq Bucket =>
(Int -> Bucket -> Int) -> (Bucket -> Int) -> Hashable Bucket
Int -> Bucket -> Int
Bucket -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Bucket -> Int
hashWithSalt :: Int -> Bucket -> Int
$chash :: Bucket -> Int
hash :: 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
$cshowsPrec :: Int -> BucketInfo -> ShowS
showsPrec :: Int -> BucketInfo -> ShowS
$cshow :: BucketInfo -> FilePath
show :: BucketInfo -> FilePath
$cshowList :: [BucketInfo] -> ShowS
showList :: [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
$cshowsPrec :: Int -> CostCentre -> ShowS
showsPrec :: Int -> CostCentre -> ShowS
$cshow :: CostCentre -> FilePath
show :: CostCentre -> FilePath
$cshowList :: [CostCentre] -> ShowS
showList :: [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
$cshowsPrec :: Int -> Sample -> ShowS
showsPrec :: Int -> Sample -> ShowS
$cshow :: Sample -> FilePath
show :: Sample -> FilePath
$cshowList :: [Sample] -> ShowS
showList :: [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
$cshowsPrec :: Int -> HeapSample -> ShowS
showsPrec :: Int -> HeapSample -> ShowS
$cshow :: HeapSample -> FilePath
show :: HeapSample -> FilePath
$cshowList :: [HeapSample] -> ShowS
showList :: [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
$cshowsPrec :: Int -> Frame -> ShowS
showsPrec :: Int -> Frame -> ShowS
$cshow :: Frame -> FilePath
show :: Frame -> FilePath
$cshowList :: [Frame] -> ShowS
showList :: [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
$cshowsPrec :: Int -> Trace -> ShowS
showsPrec :: Int -> Trace -> ShowS
$cshow :: Trace -> FilePath
show :: Trace -> FilePath
$cshowList :: [Trace] -> ShowS
showList :: [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
$cshowsPrec :: Int -> HeapInfo -> ShowS
showsPrec :: Int -> HeapInfo -> ShowS
$cshow :: HeapInfo -> FilePath
show :: HeapInfo -> FilePath
$cshowList :: [HeapInfo] -> ShowS
showList :: [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
(Int -> ProfData -> ShowS)
-> (ProfData -> FilePath) -> ([ProfData] -> ShowS) -> Show ProfData
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfData -> ShowS
showsPrec :: Int -> ProfData -> ShowS
$cshow :: ProfData -> FilePath
show :: ProfData -> FilePath
$cshowList :: [ProfData] -> ShowS
showList :: [ProfData] -> ShowS
Show

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

instance FromJSON TickyCounterArgs where
  parseJSON :: Value -> Parser TickyCounterArgs
parseJSON = FilePath
-> (Object -> Parser TickyCounterArgs)
-> Value
-> Parser TickyCounterArgs
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"TickyCounterArgs" ((Object -> Parser TickyCounterArgs)
 -> Value -> Parser TickyCounterArgs)
-> (Object -> Parser TickyCounterArgs)
-> Value
-> Parser TickyCounterArgs
forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> FilePath -> FilePath -> TickyCounterArgs
TickyCounterArgs
                (Text -> FilePath -> FilePath -> TickyCounterArgs)
-> Parser Text -> Parser (FilePath -> FilePath -> TickyCounterArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
                Parser (FilePath -> FilePath -> TickyCounterArgs)
-> Parser FilePath -> Parser (FilePath -> TickyCounterArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> FilePath
T.unpack (Text -> FilePath) -> Parser Text -> Parser FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fvs")
                Parser (FilePath -> TickyCounterArgs)
-> Parser FilePath -> Parser TickyCounterArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> FilePath
T.unpack (Text -> FilePath) -> Parser Text -> Parser FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
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
(Int -> TickyCounter -> ShowS)
-> (TickyCounter -> FilePath)
-> ([TickyCounter] -> ShowS)
-> Show TickyCounter
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickyCounter -> ShowS
showsPrec :: Int -> TickyCounter -> ShowS
$cshow :: TickyCounter -> FilePath
show :: TickyCounter -> FilePath
$cshowList :: [TickyCounter] -> ShowS
showList :: [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
(Int -> TickySample -> ShowS)
-> (TickySample -> FilePath)
-> ([TickySample] -> ShowS)
-> Show TickySample
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickySample -> ShowS
showsPrec :: Int -> TickySample -> ShowS
$cshow :: TickySample -> FilePath
show :: TickySample -> FilePath
$cshowList :: [TickySample] -> ShowS
showList :: [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
(Int -> InfoTableLoc -> ShowS)
-> (InfoTableLoc -> FilePath)
-> ([InfoTableLoc] -> ShowS)
-> Show InfoTableLoc
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InfoTableLoc -> ShowS
showsPrec :: Int -> InfoTableLoc -> ShowS
$cshow :: InfoTableLoc -> FilePath
show :: InfoTableLoc -> FilePath
$cshowList :: [InfoTableLoc] -> ShowS
showList :: [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
$c== :: InfoTablePtr -> InfoTablePtr -> Bool
== :: InfoTablePtr -> InfoTablePtr -> Bool
$c/= :: InfoTablePtr -> InfoTablePtr -> Bool
/= :: 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
$ccompare :: InfoTablePtr -> InfoTablePtr -> Ordering
compare :: InfoTablePtr -> InfoTablePtr -> Ordering
$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
>= :: InfoTablePtr -> InfoTablePtr -> Bool
$cmax :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
max :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
$cmin :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
min :: InfoTablePtr -> InfoTablePtr -> 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 => a -> ShowS
showHex Word64
p FilePath
""

toItblPointer :: Bucket -> InfoTablePtr
toItblPointer :: Bucket -> InfoTablePtr
toItblPointer = (FilePath -> InfoTablePtr)
-> (InfoTablePtr -> InfoTablePtr)
-> Either FilePath InfoTablePtr
-> InfoTablePtr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> InfoTablePtr
forall a. HasCallStack => FilePath -> a
error InfoTablePtr -> InfoTablePtr
forall a. a -> a
id (Either FilePath InfoTablePtr -> InfoTablePtr)
-> (Bucket -> Either FilePath InfoTablePtr)
-> Bucket
-> InfoTablePtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bucket -> Either FilePath InfoTablePtr
toItblPointer_either

toItblPointer_maybe :: Bucket -> Maybe InfoTablePtr
toItblPointer_maybe :: Bucket -> Maybe InfoTablePtr
toItblPointer_maybe = (FilePath -> Maybe InfoTablePtr)
-> (InfoTablePtr -> Maybe InfoTablePtr)
-> Either FilePath InfoTablePtr
-> Maybe InfoTablePtr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe InfoTablePtr -> FilePath -> Maybe InfoTablePtr
forall a b. a -> b -> a
const Maybe InfoTablePtr
forall a. Maybe a
Nothing) InfoTablePtr -> Maybe InfoTablePtr
forall a. a -> Maybe a
Just (Either FilePath InfoTablePtr -> Maybe InfoTablePtr)
-> (Bucket -> Either FilePath InfoTablePtr)
-> Bucket
-> Maybe InfoTablePtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bucket -> Either FilePath InfoTablePtr
toItblPointer_either

toItblPointer_either :: Bucket -> Either String InfoTablePtr
toItblPointer_either :: Bucket -> Either FilePath InfoTablePtr
toItblPointer_either (Bucket Text
t) =
    let s :: FilePath
s = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 (Text -> FilePath
T.unpack Text
t)
        w64 :: Either FilePath InfoTablePtr
w64 = case ReadS Word64
forall a. (Eq a, Num a) => ReadS a
readHex FilePath
s of
                ((Word64
n, FilePath
""):[(Word64, FilePath)]
_) -> InfoTablePtr -> Either FilePath InfoTablePtr
forall a. a -> Either FilePath a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> InfoTablePtr
InfoTablePtr Word64
n)
                [(Word64, FilePath)]
_ -> FilePath -> Either FilePath InfoTablePtr
forall a b. a -> Either a b
Left (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
t)
    in Either FilePath InfoTablePtr
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 = InfoTableLocStatus
-> (InfoTableLoc -> InfoTableLocStatus)
-> Maybe InfoTableLoc
-> InfoTableLocStatus
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 =
  (k -> a -> (InfoTableLocStatus, a))
-> Map k a -> Map k (InfoTableLocStatus, a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\k
k a
v -> (Maybe InfoTableLoc -> InfoTableLocStatus
mkMissing (Maybe InfoTableLoc -> InfoTableLocStatus)
-> Maybe InfoTableLoc -> InfoTableLocStatus
forall a b. (a -> b) -> a -> b
$ InfoTablePtr -> Map InfoTablePtr InfoTableLoc -> Maybe InfoTableLoc
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


data EventlogType =
    EventlogType
        { EventlogType -> Header
eventlogHeader       :: Header
        , EventlogType -> Maybe HeapProfileData
eventlogHeapProfile  :: Maybe HeapProfileData
        , EventlogType -> Maybe TickyProfileData
eventlogTickyProfile :: Maybe TickyProfileData
        }

data HeapProfileData = HeapProfileData Value (Maybe Value) (Maybe Html)

data TickyProfileData = TickyProfileData Word64 Double Html