{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Eventlog.Events(chunk) where

import GHC.RTS.Events hiding (Header, header, liveBytes, blocksSize)
import Prelude hiding (init, lookup)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Text (Text)

import Eventlog.Types
import Eventlog.Total
import Eventlog.Args (Args(..))
import Data.List (foldl')
import Data.Function
import Data.Word
import Data.Time
import Data.Time.Clock.POSIX
import qualified Data.Map as Map
import Data.Vector.Unboxed (Vector, (!?), toList)
import Data.Maybe
import Data.Version
import Text.ParserCombinators.ReadP
import Control.Monad
import Data.Char
import System.IO
import qualified Data.Trie.Map as Trie
import Data.Map.Merge.Lazy
import Data.Functor.Identity
import qualified Data.Text.Lazy.Encoding as TE
import qualified Data.Text.Lazy as TL
import Data.Aeson


type PartialHeader = Int -> Header

fromNano :: Word64 -> Double
fromNano :: Word64 -> Double
fromNano Word64
e = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
e Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e-9


chunk :: Args -> FilePath -> IO ProfData
chunk :: Args -> [Char] -> IO ProfData
chunk Args
a [Char]
f = do
  (EventLog Header
_ Data
e) <- ([Char] -> EventLog)
-> (EventLog -> EventLog) -> Either [Char] EventLog -> EventLog
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> EventLog
forall a. HasCallStack => [Char] -> a
error EventLog -> EventLog
forall a. a -> a
id (Either [Char] EventLog -> EventLog)
-> IO (Either [Char] EventLog) -> IO EventLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either [Char] EventLog)
readEventLogFromFile [Char]
f
  (PartialHeader
ph, BucketMap
bucket_map, Map Word32 CostCentre
ccMap, [Frame]
frames, [Trace]
traces, Map InfoTablePtr InfoTableLoc
ipes, HeapInfo
hdata, Map TickyCounterId TickyCounter
ticky_counters, [TickySample]
ticky_samples, Word64
total_allocs) <- Args
-> Data
-> IO
     (PartialHeader, BucketMap, Map Word32 CostCentre, [Frame], [Trace],
      Map InfoTablePtr InfoTableLoc, HeapInfo,
      Map TickyCounterId TickyCounter, [TickySample], Word64)
eventsToHP Args
a Data
e
  let (Int
counts, Map Bucket (Double, Double, Maybe (Double, Double, Double))
totals) = [Frame]
-> (Int,
    Map Bucket (Double, Double, Maybe (Double, Double, Double)))
total [Frame]
frames
      -- If both keys are present, combine
      combine :: WhenMatched
  Identity
  k
  (Text, Maybe [Word32])
  (Double, Double, Maybe (Double, Double, Double))
  BucketInfo
combine = (k
 -> (Text, Maybe [Word32])
 -> (Double, Double, Maybe (Double, Double, Double))
 -> Identity BucketInfo)
-> WhenMatched
     Identity
     k
     (Text, Maybe [Word32])
     (Double, Double, Maybe (Double, Double, Double))
     BucketInfo
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched (\k
_ (Text
t, Maybe [Word32]
mt) (Double
tot, Double
sd, Maybe (Double, Double, Double)
g) -> BucketInfo -> Identity BucketInfo
forall a. a -> Identity a
Identity (BucketInfo -> Identity BucketInfo)
-> BucketInfo -> Identity BucketInfo
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe [Word32]
-> Double
-> Double
-> Maybe (Double, Double, Double)
-> BucketInfo
BucketInfo Text
t Maybe [Word32]
mt Double
tot Double
sd Maybe (Double, Double, Double)
g)
      -- If total is missing, something bad has happened
      combineMissingTotal :: Bucket -> (Text, Maybe [Word32]) -> Identity BucketInfo
      combineMissingTotal :: Bucket -> (Text, Maybe [Word32]) -> Identity BucketInfo
combineMissingTotal Bucket
k = [Char] -> (Text, Maybe [Word32]) -> Identity BucketInfo
forall a. HasCallStack => [Char] -> a
error ([Char]
"Missing total for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bucket -> [Char]
forall a. Show a => a -> [Char]
show Bucket
k)

      -- This case happens when we are not in CC mode
      combineMissingDesc :: Bucket -> (Double, Double, Maybe (Double, Double, Double)) -> Identity BucketInfo
      combineMissingDesc :: Bucket
-> (Double, Double, Maybe (Double, Double, Double))
-> Identity BucketInfo
combineMissingDesc (Bucket Text
t) (Double
tot, Double
sd, Maybe (Double, Double, Double)
g) = BucketInfo -> Identity BucketInfo
forall a. a -> Identity a
Identity (Text
-> Maybe [Word32]
-> Double
-> Double
-> Maybe (Double, Double, Double)
-> BucketInfo
BucketInfo Text
t Maybe [Word32]
forall a. Maybe a
Nothing Double
tot Double
sd Maybe (Double, Double, Double)
g)

      binfo :: Map Bucket BucketInfo
binfo = SimpleWhenMissing Bucket (Text, Maybe [Word32]) BucketInfo
-> SimpleWhenMissing
     Bucket (Double, Double, Maybe (Double, Double, Double)) BucketInfo
-> SimpleWhenMatched
     Bucket
     (Text, Maybe [Word32])
     (Double, Double, Maybe (Double, Double, Double))
     BucketInfo
-> BucketMap
-> Map Bucket (Double, Double, Maybe (Double, Double, Double))
-> Map Bucket BucketInfo
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge ((Bucket -> (Text, Maybe [Word32]) -> Identity BucketInfo)
-> SimpleWhenMissing Bucket (Text, Maybe [Word32]) BucketInfo
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing Bucket -> (Text, Maybe [Word32]) -> Identity BucketInfo
combineMissingTotal) ((Bucket
 -> (Double, Double, Maybe (Double, Double, Double))
 -> Identity BucketInfo)
-> SimpleWhenMissing
     Bucket (Double, Double, Maybe (Double, Double, Double)) BucketInfo
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing Bucket
-> (Double, Double, Maybe (Double, Double, Double))
-> Identity BucketInfo
combineMissingDesc) SimpleWhenMatched
  Bucket
  (Text, Maybe [Word32])
  (Double, Double, Maybe (Double, Double, Double))
  BucketInfo
forall {k}.
WhenMatched
  Identity
  k
  (Text, Maybe [Word32])
  (Double, Double, Maybe (Double, Double, Double))
  BucketInfo
combine BucketMap
bucket_map Map Bucket (Double, Double, Maybe (Double, Double, Double))
totals

  ProfData -> IO ProfData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProfData -> IO ProfData) -> ProfData -> IO ProfData
forall a b. (a -> b) -> a -> b
$ (Header
-> Map Bucket BucketInfo
-> Map Word32 CostCentre
-> [Frame]
-> [Trace]
-> HeapInfo
-> Map InfoTablePtr InfoTableLoc
-> Map TickyCounterId TickyCounter
-> [TickySample]
-> Word64
-> ProfData
ProfData (PartialHeader
ph Int
counts) Map Bucket BucketInfo
binfo Map Word32 CostCentre
ccMap [Frame]
frames [Trace]
traces HeapInfo
hdata Map InfoTablePtr InfoTableLoc
ipes Map TickyCounterId TickyCounter
ticky_counters [TickySample]
ticky_samples Word64
total_allocs)

checkGHCVersion :: EL -> Maybe Text
checkGHCVersion :: EL -> Maybe Text
checkGHCVersion EL { ident :: EL -> Maybe (Version, Text)
ident = Just (Version
version,Text
_)}
  | Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= [Int] -> Version
makeVersion [Int
8,Int
4,Int
4]  =
      Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Warning: The eventlog has been generated with ghc-"
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Version -> [Char]
showVersion Version
version)
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", which does not support profiling events in the eventlog."
checkGHCVersion EL { pargs :: EL -> Maybe [Text]
pargs = Just [Text]
args, ident :: EL -> Maybe (Version, Text)
ident = Just (Version
version,Text
_)}
  | Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> [Int] -> Version
makeVersion [Int
8,Int
4,Int
4] Bool -> Bool -> Bool
&&
    Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= [Int] -> Version
makeVersion [Int
8,Int
9,Int
0] Bool -> Bool -> Bool
&&
    (Text
"-hr" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
args Bool -> Bool -> Bool
|| Text
"-hb" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
args) =
     Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Warning: The eventlog has been generated with ghc-"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Version -> [Char]
showVersion Version
version)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", which does not support biographical or retainer profiling."
checkGHCVersion EL
_ = Maybe Text
forall a. Maybe a
Nothing

eventsToHP :: Args -> Data -> IO (PartialHeader, BucketMap, Map.Map Word32 CostCentre, [Frame], [Trace]
                                 , Map.Map InfoTablePtr InfoTableLoc, HeapInfo, Map.Map TickyCounterId TickyCounter, [TickySample]
                                 , Word64)
eventsToHP :: Args
-> Data
-> IO
     (PartialHeader, BucketMap, Map Word32 CostCentre, [Frame], [Trace],
      Map InfoTablePtr InfoTableLoc, HeapInfo,
      Map TickyCounterId TickyCounter, [TickySample], Word64)
eventsToHP Args
a (Data [Event]
es) = do
  let
      el :: EL
el@EL{[(InfoTablePtr, InfoTableLoc)]
[TickySample]
[TickyCounter]
[Trace]
[HeapSample]
[FrameEL]
Maybe [Char]
Maybe [Text]
Maybe Word64
Maybe (Version, Text)
Maybe HeapProfBreakdown
Maybe FrameEL
Word64
Map Word32 Word64
Map Word32 CostCentre
BucketMap
CCSMap
ident :: EL -> Maybe (Version, Text)
pargs :: EL -> Maybe [Text]
pargs :: Maybe [Text]
programInvocation :: Maybe [Char]
heapSize :: [HeapSample]
liveBytes :: [HeapSample]
blocksSize :: [HeapSample]
ident :: Maybe (Version, Text)
samplingRate :: Maybe Word64
heapProfileType :: Maybe HeapProfBreakdown
ccMap :: Map Word32 CostCentre
bucketMap :: BucketMap
ccsMap :: CCSMap
clocktimeSec :: Word64
samples :: Maybe FrameEL
frames :: [FrameEL]
traces :: [Trace]
ipes :: [(InfoTablePtr, InfoTableLoc)]
ticky_samples :: [TickySample]
ticky_counter :: [TickyCounter]
start :: Word64
end :: Word64
total_allocs :: Map Word32 Word64
programInvocation :: EL -> Maybe [Char]
heapSize :: EL -> [HeapSample]
liveBytes :: EL -> [HeapSample]
blocksSize :: EL -> [HeapSample]
samplingRate :: EL -> Maybe Word64
heapProfileType :: EL -> Maybe HeapProfBreakdown
ccMap :: EL -> Map Word32 CostCentre
bucketMap :: EL -> BucketMap
ccsMap :: EL -> CCSMap
clocktimeSec :: EL -> Word64
samples :: EL -> Maybe FrameEL
frames :: EL -> [FrameEL]
traces :: EL -> [Trace]
ipes :: EL -> [(InfoTablePtr, InfoTableLoc)]
ticky_samples :: EL -> [TickySample]
ticky_counter :: EL -> [TickyCounter]
start :: EL -> Word64
end :: EL -> Word64
total_allocs :: EL -> Map Word32 Word64
..} = Args -> [Event] -> EL
foldEvents Args
a [Event]
es
      fir :: Frame
fir = Double -> [Sample] -> Frame
Frame (Word64 -> Double
fromNano Word64
start) []
      las :: Frame
las = Double -> [Sample] -> Frame
Frame (Word64 -> Double
fromNano Word64
end) []
  (Text -> IO ()) -> Maybe Text -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr) (EL -> Maybe Text
checkGHCVersion EL
el)
  let heapInfo :: HeapInfo
heapInfo = [HeapSample] -> [HeapSample] -> [HeapSample] -> HeapInfo
HeapInfo ([HeapSample] -> [HeapSample]
forall a. [a] -> [a]
reverse [HeapSample]
heapSize) ([HeapSample] -> [HeapSample]
forall a. [a] -> [a]
reverse [HeapSample]
blocksSize) ([HeapSample] -> [HeapSample]
forall a. [a] -> [a]
reverse [HeapSample]
liveBytes)

      ticky_counter_map :: Map TickyCounterId TickyCounter
ticky_counter_map = [(TickyCounterId, TickyCounter)] -> Map TickyCounterId TickyCounter
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> TickyCounterId
TickyCounterId (TickyCounter -> Word64
tickyCtrId TickyCounter
t) , TickyCounter
t) | TickyCounter
t <- [TickyCounter]
ticky_counter]
  (PartialHeader, BucketMap, Map Word32 CostCentre, [Frame], [Trace],
 Map InfoTablePtr InfoTableLoc, HeapInfo,
 Map TickyCounterId TickyCounter, [TickySample], Word64)
-> IO
     (PartialHeader, BucketMap, Map Word32 CostCentre, [Frame], [Trace],
      Map InfoTablePtr InfoTableLoc, HeapInfo,
      Map TickyCounterId TickyCounter, [TickySample], Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((PartialHeader, BucketMap, Map Word32 CostCentre, [Frame],
  [Trace], Map InfoTablePtr InfoTableLoc, HeapInfo,
  Map TickyCounterId TickyCounter, [TickySample], Word64)
 -> IO
      (PartialHeader, BucketMap, Map Word32 CostCentre, [Frame], [Trace],
       Map InfoTablePtr InfoTableLoc, HeapInfo,
       Map TickyCounterId TickyCounter, [TickySample], Word64))
-> (PartialHeader, BucketMap, Map Word32 CostCentre, [Frame],
    [Trace], Map InfoTablePtr InfoTableLoc, HeapInfo,
    Map TickyCounterId TickyCounter, [TickySample], Word64)
-> IO
     (PartialHeader, BucketMap, Map Word32 CostCentre, [Frame], [Trace],
      Map InfoTablePtr InfoTableLoc, HeapInfo,
      Map TickyCounterId TickyCounter, [TickySample], Word64)
forall a b. (a -> b) -> a -> b
$ (EL -> PartialHeader
elHeader EL
el, EL -> BucketMap
elBucketMap EL
el, Map Word32 CostCentre
ccMap, Frame
fir Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
: [Frame] -> [Frame]
forall a. [a] -> [a]
reverse (Frame
lasFrame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
: [FrameEL] -> [Frame]
normalise [FrameEL]
frames)
           , [Trace] -> [Trace]
forall a. [a] -> [a]
reverse [Trace]
traces, [(InfoTablePtr, InfoTableLoc)] -> Map InfoTablePtr InfoTableLoc
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(InfoTablePtr, InfoTableLoc)]
ipes, HeapInfo
heapInfo, Map TickyCounterId TickyCounter
ticky_counter_map
           , [TickySample]
ticky_samples
           , Map Word32 Word64 -> Word64
forall a. Num a => Map Word32 a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Map Word32 Word64
total_allocs))

normalise :: [FrameEL] -> [Frame]
normalise :: [FrameEL] -> [Frame]
normalise = (FrameEL -> Frame) -> [FrameEL] -> [Frame]
forall a b. (a -> b) -> [a] -> [b]
map (\(FrameEL Word64
t [Sample]
ss) -> Double -> [Sample] -> Frame
Frame (Word64 -> Double
fromNano Word64
t) [Sample]
ss)

type BucketMap = Map.Map Bucket (Text, Maybe [Word32])

data EL = EL
  { EL -> Maybe [Text]
pargs :: !(Maybe [Text])
  , EL -> Maybe [Char]
programInvocation :: !(Maybe FilePath)
  , EL -> [HeapSample]
heapSize :: ![HeapSample]
  , EL -> [HeapSample]
liveBytes :: ![HeapSample]
  , EL -> [HeapSample]
blocksSize :: ![HeapSample]
  , EL -> Maybe (Version, Text)
ident :: Maybe (Version, Text)
  , EL -> Maybe Word64
samplingRate :: !(Maybe Word64)
  , EL -> Maybe HeapProfBreakdown
heapProfileType :: !(Maybe HeapProfBreakdown)
  , EL -> Map Word32 CostCentre
ccMap :: !(Map.Map Word32 CostCentre)
  -- At the moment bucketMap and CCS map are quite similar, cost centre profiling
  -- is the only mode to populate the bucket map
  , EL -> BucketMap
bucketMap :: BucketMap
  , EL -> CCSMap
ccsMap :: CCSMap
  , EL -> Word64
clocktimeSec :: !Word64
  , EL -> Maybe FrameEL
samples :: !(Maybe FrameEL)
  , EL -> [FrameEL]
frames :: ![FrameEL]
  , EL -> [Trace]
traces :: ![Trace]
  , EL -> [(InfoTablePtr, InfoTableLoc)]
ipes :: ![(InfoTablePtr, InfoTableLoc)]
  , EL -> [TickySample]
ticky_samples :: ![TickySample]
  , EL -> [TickyCounter]
ticky_counter :: ![TickyCounter]
  , EL -> Word64
start :: !Word64
  , EL -> Word64
end :: !Word64
  , EL -> Map Word32 Word64
total_allocs :: !(Map.Map Capset Word64) } deriving Int -> EL -> [Char] -> [Char]
[EL] -> [Char] -> [Char]
EL -> [Char]
(Int -> EL -> [Char] -> [Char])
-> (EL -> [Char]) -> ([EL] -> [Char] -> [Char]) -> Show EL
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> EL -> [Char] -> [Char]
showsPrec :: Int -> EL -> [Char] -> [Char]
$cshow :: EL -> [Char]
show :: EL -> [Char]
$cshowList :: [EL] -> [Char] -> [Char]
showList :: [EL] -> [Char] -> [Char]
Show




data FrameEL = FrameEL Word64 [Sample] deriving Int -> FrameEL -> [Char] -> [Char]
[FrameEL] -> [Char] -> [Char]
FrameEL -> [Char]
(Int -> FrameEL -> [Char] -> [Char])
-> (FrameEL -> [Char])
-> ([FrameEL] -> [Char] -> [Char])
-> Show FrameEL
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> FrameEL -> [Char] -> [Char]
showsPrec :: Int -> FrameEL -> [Char] -> [Char]
$cshow :: FrameEL -> [Char]
show :: FrameEL -> [Char]
$cshowList :: [FrameEL] -> [Char] -> [Char]
showList :: [FrameEL] -> [Char] -> [Char]
Show

data CCSMap = CCSMap (Trie.TMap Word32 CCStack) Int deriving Int -> CCSMap -> [Char] -> [Char]
[CCSMap] -> [Char] -> [Char]
CCSMap -> [Char]
(Int -> CCSMap -> [Char] -> [Char])
-> (CCSMap -> [Char])
-> ([CCSMap] -> [Char] -> [Char])
-> Show CCSMap
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> CCSMap -> [Char] -> [Char]
showsPrec :: Int -> CCSMap -> [Char] -> [Char]
$cshow :: CCSMap -> [Char]
show :: CCSMap -> [Char]
$cshowList :: [CCSMap] -> [Char] -> [Char]
showList :: [CCSMap] -> [Char] -> [Char]
Show


data CCStack = CCStack { CCStack -> Int
ccsId :: Int, CCStack -> Text
ccsName :: Text } deriving Int -> CCStack -> [Char] -> [Char]
[CCStack] -> [Char] -> [Char]
CCStack -> [Char]
(Int -> CCStack -> [Char] -> [Char])
-> (CCStack -> [Char])
-> ([CCStack] -> [Char] -> [Char])
-> Show CCStack
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> CCStack -> [Char] -> [Char]
showsPrec :: Int -> CCStack -> [Char] -> [Char]
$cshow :: CCStack -> [Char]
show :: CCStack -> [Char]
$cshowList :: [CCStack] -> [Char] -> [Char]
showList :: [CCStack] -> [Char] -> [Char]
Show

getCCSId :: EL -> Vector Word32 -> (CCStack, EL)
getCCSId :: EL -> Vector Word32 -> (CCStack, EL)
getCCSId el :: EL
el@EL { ccsMap :: EL -> CCSMap
ccsMap = (CCSMap TMap Word32 CCStack
trie Int
uniq), ccMap :: EL -> Map Word32 CostCentre
ccMap = Map Word32 CostCentre
ccMap } Vector Word32
k  =
  let kl :: [Word32]
kl = [Word32] -> [Word32]
forall a. [a] -> [a]
reverse ([Word32] -> [Word32]) -> [Word32] -> [Word32]
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> [Word32]
forall a. Unbox a => Vector a -> [a]
toList Vector Word32
k
  in case [Word32] -> TMap Word32 CCStack -> Maybe CCStack
forall c a. Ord c => [c] -> TMap c a -> Maybe a
Trie.lookup [Word32]
kl TMap Word32 CCStack
trie of
        Just CCStack
n -> (CCStack
n, EL
el)
        Maybe CCStack
Nothing ->
          let new_stack :: CCStack
new_stack = Int -> Text -> CCStack
CCStack Int
uniq Text
name

              sid :: Text
sid = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
uniq [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") "
              short_bucket_info :: Text
short_bucket_info = Text
sid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
              bucket_info :: (Text, Maybe [Word32])
bucket_info = (Text
short_bucket_info, [Word32] -> Maybe [Word32]
forall a. a -> Maybe a
Just [Word32]
kl)
              bucket_key :: Bucket
bucket_key = Text -> Bucket
Bucket ([Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
uniq))
          in (CCStack
new_stack, EL
el { ccsMap = CCSMap (Trie.insert kl new_stack trie) (uniq + 1)
                            , bucketMap = Map.insert bucket_key bucket_info (bucketMap el) })
  where
    name :: Text
name = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"MAIN" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ do
             Word32
cid <- (Vector Word32
k Vector Word32 -> Int -> Maybe Word32
forall a. Unbox a => Vector a -> Int -> Maybe a
!? Int
0)
             CC{Text
label :: Text
label :: CostCentre -> Text
label} <- Word32 -> Map Word32 CostCentre -> Maybe CostCentre
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word32
cid Map Word32 CostCentre
ccMap
             Text -> Maybe Text
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
label


initEL :: EL
initEL :: EL
initEL = EL
  { pargs :: Maybe [Text]
pargs = Maybe [Text]
forall a. Maybe a
Nothing
  , ident :: Maybe (Version, Text)
ident = Maybe (Version, Text)
forall a. Maybe a
Nothing
  , samplingRate :: Maybe Word64
samplingRate = Maybe Word64
forall a. Maybe a
Nothing
  , heapProfileType :: Maybe HeapProfBreakdown
heapProfileType = Maybe HeapProfBreakdown
forall a. Maybe a
Nothing
  , clocktimeSec :: Word64
clocktimeSec = Word64
0
  , samples :: Maybe FrameEL
samples = Maybe FrameEL
forall a. Maybe a
Nothing
  , heapSize :: [HeapSample]
heapSize = []
  , liveBytes :: [HeapSample]
liveBytes = []
  , blocksSize :: [HeapSample]
blocksSize = []
  , frames :: [FrameEL]
frames = []
  , traces :: [Trace]
traces = []
  , ipes :: [(InfoTablePtr, InfoTableLoc)]
ipes = []
  , start :: Word64
start = Word64
0
  , end :: Word64
end = Word64
0
  , ccMap :: Map Word32 CostCentre
ccMap = Map Word32 CostCentre
forall k a. Map k a
Map.empty
  , ccsMap :: CCSMap
ccsMap =  TMap Word32 CCStack -> Int -> CCSMap
CCSMap TMap Word32 CCStack
forall c a. TMap c a
Trie.empty Int
0
  , bucketMap :: BucketMap
bucketMap = BucketMap
forall k a. Map k a
Map.empty
  , programInvocation :: Maybe [Char]
programInvocation = Maybe [Char]
forall a. Maybe a
Nothing
  , ticky_samples :: [TickySample]
ticky_samples = []
  , ticky_counter :: [TickyCounter]
ticky_counter = []
  , total_allocs :: Map Word32 Word64
total_allocs  = Map Word32 Word64
forall k a. Map k a
Map.empty
  }

foldEvents :: Args -> [Event] -> EL
foldEvents :: Args -> [Event] -> EL
foldEvents Args
a [Event]
es =
  let res :: EL
res = (EL -> Event -> EL) -> EL -> [Event] -> EL
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Args -> EL -> Event -> EL
folder Args
a) EL
initEL [Event]
es
  in Word64 -> EL -> EL
addFrame Word64
0 EL
res

folder :: Args -> EL -> Event -> EL
folder :: Args -> EL -> Event -> EL
folder Args
a EL
el (Event Word64
t EventInfo
e Maybe Int
_) = EL
el EL -> (EL -> EL) -> EL
forall a b. a -> (a -> b) -> b
&
  Word64 -> EL -> EL
updateLast Word64
t (EL -> EL) -> (EL -> EL) -> EL -> EL
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    case EventInfo
e of
      -- Traces
      -- Messages and UserMessages correspond to high-frequency "traceEvent" or "traceEventIO" events from Debug.Trace and
      -- are only included if "--include-trace-events" has been specified.
      -- For low-frequency events "traceMarker" or "traceMarkerIO" should be used, which generate "UserMarker" events.
      Message Text
s -> if Args -> Bool
traceEvents Args
a then Args -> Trace -> EL -> EL
addTrace Args
a (Double -> Text -> Trace
Trace (Word64 -> Double
fromNano Word64
t) Text
s) else EL -> EL
forall a. a -> a
id
      UserMessage Text
s -> if Args -> Bool
traceEvents Args
a then Args -> Trace -> EL -> EL
addTrace Args
a (Double -> Text -> Trace
Trace (Word64 -> Double
fromNano Word64
t) Text
s) else EL -> EL
forall a. a -> a
id
      UserMarker Text
s -> Args -> Trace -> EL -> EL
addTrace Args
a (Double -> Text -> Trace
Trace (Word64 -> Double
fromNano Word64
t) Text
s)
      -- Information about the program
      RtsIdentifier Word32
_ Text
ident -> Text -> EL -> EL
addIdent Text
ident
      ProgramArgs Word32
_ [Text]
as -> [Text] -> EL -> EL
addArgs [Text]
as
      ProgramInvocation [Char]
inv -> [Char] -> EL -> EL
addInvocation [Char]
inv
      WallClockTime Word32
_ Word64
s Word32
_ -> Word64 -> EL -> EL
addClocktime Word64
s
      -- Profiling Events
      HeapProfBegin { Word64
heapProfSamplingPeriod :: Word64
heapProfSamplingPeriod :: EventInfo -> Word64
heapProfSamplingPeriod, HeapProfBreakdown
heapProfBreakdown :: HeapProfBreakdown
heapProfBreakdown :: EventInfo -> HeapProfBreakdown
heapProfBreakdown } -> Word64 -> HeapProfBreakdown -> EL -> EL
addHeapProfBegin Word64
heapProfSamplingPeriod HeapProfBreakdown
heapProfBreakdown
      HeapProfCostCentre Word32
cid Text
l Text
m Text
loc HeapProfFlags
_  -> Word32 -> CostCentre -> EL -> EL
addCostCentre Word32
cid (Word32 -> Text -> Text -> Text -> CostCentre
CC Word32
cid Text
l Text
m Text
loc)
      HeapProfSampleBegin {}
        | Word64
t Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1 -> Word64 -> EL -> EL
addFrame Word64
t
      HeapBioProfSampleBegin { heapProfSampleTime :: EventInfo -> Word64
heapProfSampleTime = Word64
t' } -> Word64 -> EL -> EL
addFrame Word64
t'
      HeapProfSampleCostCentre Word8
_hid Word64
r Word8
d Vector Word32
s -> Word64 -> Word8 -> Vector Word32 -> EL -> EL
addCCSample Word64
r Word8
d Vector Word32
s
      HeapProfSampleString Word8
_hid Word64
res Text
k -> Sample -> EL -> EL
addSample (Bucket -> Double -> Sample
Sample (Text -> Bucket
Bucket Text
k) (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
res))
      InfoTableProv Word64
ptr Text
name Int
desc Text
ty Text
lbl Text
smod Text
sloc -> (InfoTablePtr, InfoTableLoc) -> EL -> EL
addInfoTableLoc (Word64 -> InfoTablePtr
InfoTablePtr Word64
ptr,
                                              Text -> ClosureType -> Text -> Text -> Text -> Text -> InfoTableLoc
InfoTableLoc Text
name (Int -> ClosureType
parseClosureType Int
desc) Text
ty Text
lbl Text
smod Text
sloc)
      HeapSize Word32
_ Word64
b -> Word64 -> Word64 -> EL -> EL
addHeapSize Word64
t Word64
b
      HeapLive Word32
_ Word64
b -> Word64 -> Word64 -> EL -> EL
addHeapLive Word64
t Word64
b
      BlocksSize Word32
_ Word64
b -> Word64 -> Word64 -> EL -> EL
addBlocksSize Word64
t Word64
b
      TickyCounterDef Word64
defid Word16
arity Text
_ Text
name Word64
tid (Just Text
json_desc) -> Word64 -> Word16 -> Text -> Word64 -> Text -> EL -> EL
addTickyDef Word64
defid Word16
arity Text
name Word64
tid Text
json_desc
      TickyCounterSample Word64
defid Word64
entries Word64
allocs Word64
allocd -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> EL -> EL
addTickySample Word64
t Word64
defid Word64
entries Word64
allocs Word64
allocd

      HeapAllocated Word32
cp Word64
alloc_bytes -> Word32 -> Word64 -> EL -> EL
addHeapAllocated Word32
cp Word64
alloc_bytes
      EventInfo
_ -> EL -> EL
forall a. a -> a
id

addHeapAllocated :: Capset -> Word64 -> EL -> EL
-- The counter is the total since the start of the program.
addHeapAllocated :: Word32 -> Word64 -> EL -> EL
addHeapAllocated Word32
cid Word64
w64 EL
el = EL
el { total_allocs = Map.insert cid w64 (total_allocs el)}

parseClosureType :: Int -> ClosureType
parseClosureType :: Int -> ClosureType
parseClosureType Int
ct = Int -> ClosureType
forall a. Enum a => Int -> a
toEnum Int
ct

addInfoTableLoc :: (InfoTablePtr, InfoTableLoc) -> EL -> EL
addInfoTableLoc :: (InfoTablePtr, InfoTableLoc) -> EL -> EL
addInfoTableLoc (InfoTablePtr, InfoTableLoc)
itl EL
el = EL
el { ipes = itl : ipes el }

addHeapProfBegin :: Word64 -> HeapProfBreakdown -> EL -> EL
addHeapProfBegin :: Word64 -> HeapProfBreakdown -> EL -> EL
addHeapProfBegin Word64
sr HeapProfBreakdown
hptype EL
el = EL
el { samplingRate = Just sr, heapProfileType = Just hptype }

addIdent :: Text -> EL -> EL
addIdent :: Text -> EL -> EL
addIdent Text
s EL
el = EL
el { ident = fmap T.pack <$> (parseIdent (T.unpack s)) }

parseIdent :: String -> Maybe (Version, String)
parseIdent :: [Char] -> Maybe (Version, [Char])
parseIdent [Char]
s = [(Version, [Char])] -> Maybe (Version, [Char])
forall a. [a] -> Maybe a
listToMaybe ([(Version, [Char])] -> Maybe (Version, [Char]))
-> [(Version, [Char])] -> Maybe (Version, [Char])
forall a b. (a -> b) -> a -> b
$ (ReadP Version -> [Char] -> [(Version, [Char])])
-> [Char] -> ReadP Version -> [(Version, [Char])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReadP Version -> [Char] -> [(Version, [Char])]
forall a. ReadP a -> ReadS a
readP_to_S [Char]
s (ReadP Version -> [(Version, [Char])])
-> ReadP Version -> [(Version, [Char])]
forall a b. (a -> b) -> a -> b
$ do
  ReadP [Char] -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP [Char] -> ReadP ()) -> ReadP [Char] -> ReadP ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ReadP [Char]
string [Char]
"GHC-"
  [Int
v1, Int
v2, Int
v3] <- Int -> ReadP Int -> ReadP [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (ReadP Int
intP ReadP Int -> ReadP () -> ReadP Int
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
optional (Char -> ReadP Char
char Char
'.'))
  ReadP ()
skipSpaces
  Version -> ReadP Version
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Version
makeVersion [Int
v1,Int
v2,Int
v3])
  where
    intP :: ReadP Int
intP = do
      [Char]
x <- (Char -> Bool) -> ReadP [Char]
munch1 Char -> Bool
isDigit
      Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ReadP Int) -> Int -> ReadP Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
x

addCostCentre :: Word32 -> CostCentre -> EL -> EL
addCostCentre :: Word32 -> CostCentre -> EL -> EL
addCostCentre Word32
s CostCentre
cc EL
el = EL
el { ccMap = Map.insert s cc (ccMap el) }

addCCSample :: Word64 -> Word8 -> Vector Word32 -> EL -> EL
addCCSample :: Word64 -> Word8 -> Vector Word32 -> EL -> EL
addCCSample Word64
res Word8
_sd Vector Word32
st EL
el =
  let (CCStack Int
stack_id Text
_tid, EL
el') = EL -> Vector Word32 -> (CCStack, EL)
getCCSId EL
el Vector Word32
st
      -- TODO: Can do better than this by differentiating normal samples form stack samples
      sample_string :: Text
sample_string = [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
stack_id)
  in Sample -> EL -> EL
addSample (Bucket -> Double -> Sample
Sample (Text -> Bucket
Bucket Text
sample_string) (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
res)) EL
el'


addClocktime :: Word64 -> EL -> EL
addClocktime :: Word64 -> EL -> EL
addClocktime Word64
s EL
el = EL
el { clocktimeSec = s }

addArgs :: [Text] -> EL -> EL
addArgs :: [Text] -> EL -> EL
addArgs [Text]
as EL
el = EL
el { pargs = Just as }

addInvocation :: String -> EL -> EL
addInvocation :: [Char] -> EL -> EL
addInvocation [Char]
inv EL
el = EL
el { programInvocation = Just inv }

addHeapLive :: Timestamp -> Word64 -> EL -> EL
addHeapLive :: Word64 -> Word64 -> EL -> EL
addHeapLive Word64
t Word64
s EL
el = EL
el { liveBytes = HeapSample (fromNano t) s : liveBytes el }

addHeapSize :: Timestamp -> Word64 -> EL -> EL
addHeapSize :: Word64 -> Word64 -> EL -> EL
addHeapSize Word64
t Word64
s EL
el = EL
el { heapSize = HeapSample (fromNano t) s : heapSize el }

addBlocksSize :: Timestamp -> Word64 -> EL -> EL
addBlocksSize :: Word64 -> Word64 -> EL -> EL
addBlocksSize Word64
t Word64
s EL
el = EL
el { blocksSize = HeapSample (fromNano t) s : blocksSize el}

addTickyDef :: Word64 -> Word16 -> Text -> Word64 -> Text -> EL -> EL
addTickyDef :: Word64 -> Word16 -> Text -> Word64 -> Text -> EL -> EL
addTickyDef Word64
a Word16
b Text
d Word64
e Text
ticky_json EL
el =
  case ByteString -> Maybe TickyCounterArgs
forall a. FromJSON a => ByteString -> Maybe a
decode (Text -> ByteString
TE.encodeUtf8 (Text -> Text
TL.fromStrict Text
ticky_json)) of
    Just TickyCounterArgs
argInfo -> EL
el { ticky_counter = TickyCounter a b argInfo d (InfoTablePtr e) : ticky_counter el }
    Maybe TickyCounterArgs
Nothing   -> EL
el

addTickySample :: Timestamp -> Word64 -> Word64 -> Word64 -> Word64 -> EL -> EL
addTickySample :: Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> EL -> EL
addTickySample Word64
t Word64
a Word64
b Word64
c Word64
d EL
el = EL
el { ticky_samples = TickySample a b c d (fromNano t) : ticky_samples el }


-- | Decide whether to include a trace based on the "includes" and
-- "excludes" options.
--
-- If a trace satisfies an `-i` flag then it is certainly included.
--
-- For example for a trace called "eventlog2html" then `-i eventlog -x
-- html` will still include the trace because the `-i` option matches.
--
-- If a trace doesn't match an `-i` flag then it is excluded if it matches
-- a `-x` flag.
--
filterTrace :: [Text] -> [Text] -> Trace -> Bool
filterTrace :: [Text] -> [Text] -> Trace -> Bool
filterTrace []       []       Trace
_             = Bool
True
filterTrace []       [Text]
excludes (Trace Double
_ Text
trc) =
  Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isInfixOf Text
trc) [Text]
excludes)
filterTrace [Text]
includes []       (Trace Double
_ Text
trc) =
  (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isInfixOf Text
trc) [Text]
includes
filterTrace [Text]
includes [Text]
excludes (Trace Double
_ Text
trc) =
  (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isInfixOf Text
trc) [Text]
includes
    Bool -> Bool -> Bool
|| Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isInfixOf Text
trc) [Text]
excludes)

addTrace :: Args -> Trace -> EL -> EL
addTrace :: Args -> Trace -> EL -> EL
addTrace Args
a Trace
t EL
el | Args -> Bool
noTraces Args
a = EL
el
                | Trace -> Bool
prop Trace
t     = EL
el { traces = t : traces el }
                | Bool
otherwise  = EL
el
  where
    prop :: Trace -> Bool
prop = [Text] -> [Text] -> Trace -> Bool
filterTrace (Args -> [Text]
includeStr Args
a) (Args -> [Text]
excludeStr Args
a)

addFrame :: Word64 -> EL -> EL
addFrame :: Word64 -> EL -> EL
addFrame Word64
t EL
el =
  EL
el { samples = Just (FrameEL t [])
     , frames = sampleToFrames (samples el) (frames el) }

sampleToFrames :: Maybe FrameEL -> [FrameEL]
                                -> [FrameEL]
sampleToFrames :: Maybe FrameEL -> [FrameEL] -> [FrameEL]
sampleToFrames (Just (FrameEL Word64
t [Sample]
ss)) [FrameEL]
fs = Word64 -> [Sample] -> FrameEL
FrameEL Word64
t ([Sample] -> [Sample]
forall a. [a] -> [a]
reverse [Sample]
ss) FrameEL -> [FrameEL] -> [FrameEL]
forall a. a -> [a] -> [a]
: [FrameEL]
fs
sampleToFrames Maybe FrameEL
Nothing [FrameEL]
fs = [FrameEL]
fs

addSample :: Sample -> EL -> EL
addSample :: Sample -> EL -> EL
addSample Sample
s EL
el = EL
el { samples = go <$> (samples el) }
  where
    go :: FrameEL -> FrameEL
go (FrameEL Word64
t [Sample]
ss) = Word64 -> [Sample] -> FrameEL
FrameEL Word64
t (Sample
sSample -> [Sample] -> [Sample]
forall a. a -> [a] -> [a]
:[Sample]
ss)

updateLast :: Word64 -> EL -> EL
updateLast :: Word64 -> EL -> EL
updateLast Word64
t EL
el = EL
el { end = t }

formatDate :: Word64 -> T.Text
formatDate :: Word64 -> Text
formatDate Word64
sec =
  let posixTime :: POSIXTime
      posixTime :: POSIXTime
posixTime = Word64 -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
sec
  in
    [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%d, %H:%M %Z" (POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
posixTime)

elHeader :: EL -> PartialHeader
elHeader :: EL -> PartialHeader
elHeader EL{[(InfoTablePtr, InfoTableLoc)]
[TickySample]
[TickyCounter]
[Trace]
[HeapSample]
[FrameEL]
Maybe [Char]
Maybe [Text]
Maybe Word64
Maybe (Version, Text)
Maybe HeapProfBreakdown
Maybe FrameEL
Word64
Map Word32 Word64
Map Word32 CostCentre
BucketMap
CCSMap
ident :: EL -> Maybe (Version, Text)
pargs :: EL -> Maybe [Text]
programInvocation :: EL -> Maybe [Char]
heapSize :: EL -> [HeapSample]
liveBytes :: EL -> [HeapSample]
blocksSize :: EL -> [HeapSample]
samplingRate :: EL -> Maybe Word64
heapProfileType :: EL -> Maybe HeapProfBreakdown
ccMap :: EL -> Map Word32 CostCentre
bucketMap :: EL -> BucketMap
ccsMap :: EL -> CCSMap
clocktimeSec :: EL -> Word64
samples :: EL -> Maybe FrameEL
frames :: EL -> [FrameEL]
traces :: EL -> [Trace]
ipes :: EL -> [(InfoTablePtr, InfoTableLoc)]
ticky_samples :: EL -> [TickySample]
ticky_counter :: EL -> [TickyCounter]
start :: EL -> Word64
end :: EL -> Word64
total_allocs :: EL -> Map Word32 Word64
pargs :: Maybe [Text]
programInvocation :: Maybe [Char]
heapSize :: [HeapSample]
liveBytes :: [HeapSample]
blocksSize :: [HeapSample]
ident :: Maybe (Version, Text)
samplingRate :: Maybe Word64
heapProfileType :: Maybe HeapProfBreakdown
ccMap :: Map Word32 CostCentre
bucketMap :: BucketMap
ccsMap :: CCSMap
clocktimeSec :: Word64
samples :: Maybe FrameEL
frames :: [FrameEL]
traces :: [Trace]
ipes :: [(InfoTablePtr, InfoTableLoc)]
ticky_samples :: [TickySample]
ticky_counter :: [TickyCounter]
start :: Word64
end :: Word64
total_allocs :: Map Word32 Word64
..} =
  let title :: Text
title = Text -> ([Text] -> Text) -> Maybe [Text] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" [Text] -> Text
T.unwords Maybe [Text]
pargs
      date :: Text
date = Word64 -> Text
formatDate Word64
clocktimeSec
      ppSamplingRate :: Text
ppSamplingRate = [Char] -> Text
T.pack ([Char] -> Text)
-> (Maybe Word64 -> [Char]) -> Maybe Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> (Word64 -> [Char]) -> Maybe Word64 -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"<Not available>" (Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char]) -> (Word64 -> Double) -> Word64 -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
fromNano) (Maybe Word64 -> Text) -> Maybe Word64 -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Word64
samplingRate
  in \Int
v -> Text
-> Text
-> Maybe HeapProfBreakdown
-> Text
-> Text
-> Text
-> Int
-> Maybe [Char]
-> Header
Header Text
title Text
date Maybe HeapProfBreakdown
heapProfileType Text
ppSamplingRate Text
"" Text
"" Int
v (Text -> [Char]
T.unpack (Text -> [Char]) -> ([Text] -> Text) -> [Text] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. HasCallStack => [a] -> a
head ([Text] -> [Char]) -> Maybe [Text] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
pargs)


elBucketMap :: EL -> BucketMap
elBucketMap :: EL -> BucketMap
elBucketMap = EL -> BucketMap
bucketMap