{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.RTS.Events.Binary
  ( -- * Readers
    getHeader
  , getEvent
  , standardParsers
  , ghc6Parsers
  , ghc7Parsers
  , mercuryParsers
  , perfParsers
  , heapProfParsers
  , timeProfParsers
  , pre77StopParsers
  , ghc782StopParser
  , post782StopParser
  , parRTSParsers
  , binaryEventParsers

  -- * Writers
  , putEventLog
  , putHeader
  , putEvent

  -- * Perf events
  , nEVENT_PERF_NAME
  , nEVENT_PERF_COUNTER
  , nEVENT_PERF_TRACEPOINT

  ) where
import Control.Exception (assert)
import Control.Monad
import Data.List (intersperse)
import Data.Maybe
import Prelude hiding (gcd, rem, id)

import Data.Array
import Data.Binary
import Data.Binary.Put
import qualified Data.Binary.Get as G
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Vector.Unboxed as VU

import GHC.RTS.EventTypes
import GHC.RTS.EventParserUtils

#define EVENTLOG_CONSTANTS_ONLY
#include "EventLogFormat.h"

getEventType :: Get EventType
getEventType :: Get EventType
getEventType = do
           EventTypeNum
etNum <- Get EventTypeNum
forall t. Binary t => Get t
get
           EventTypeNum
size <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get EventTypeSize
           let etSize :: Maybe EventTypeNum
etSize = if EventTypeNum
size EventTypeNum -> EventTypeNum -> Bool
forall a. Eq a => a -> a -> Bool
== EventTypeNum
0xffff then Maybe EventTypeNum
forall a. Maybe a
Nothing else EventTypeNum -> Maybe EventTypeNum
forall a. a -> Maybe a
Just EventTypeNum
size
           -- 0xffff indicates variable-sized event
           EventTypeDescLen
etDescLen <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get EventTypeDescLen
           Text
etDesc <- EventTypeDescLen -> Get Text
forall a. Integral a => a -> Get Text
getText EventTypeDescLen
etDescLen
           EventTypeDescLen
etExtraLen <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Word32
           Int -> Get ()
G.skip (EventTypeDescLen -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeDescLen
etExtraLen)
           EventTypeDescLen
ete <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Marker
           Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventTypeDescLen
ete EventTypeDescLen -> EventTypeDescLen -> Bool
forall a. Eq a => a -> a -> Bool
/= EVENT_ET_END(Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
) $
              String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Event Type end marker not found."
           EventType -> Get EventType
forall (m :: * -> *) a. Monad m => a -> m a
return (EventTypeNum -> Text -> Maybe EventTypeNum -> EventType
EventType EventTypeNum
etNum Text
etDesc Maybe EventTypeNum
etSize)

getHeader :: Get Header
getHeader :: Get Header
getHeader = do
            EventTypeDescLen
hdrb <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Marker
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventTypeDescLen
hdrb EventTypeDescLen -> EventTypeDescLen -> Bool
forall a. Eq a => a -> a -> Bool
/= EVENT_HEADER_BEGIN) $
                 String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Header begin marker not found"
            EventTypeDescLen
hetm <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Marker
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventTypeDescLen
hetm EventTypeDescLen -> EventTypeDescLen -> Bool
forall a. Eq a => a -> a -> Bool
/= EVENT_HET_BEGIN) $
                 String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Header Event Type begin marker not found"
            [EventType]
ets <- Get [EventType]
getEventTypes
            EventTypeDescLen
emark <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Marker
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventTypeDescLen
emark EventTypeDescLen -> EventTypeDescLen -> Bool
forall a. Eq a => a -> a -> Bool
/= EVENT_HEADER_END) $
                 String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Header end marker not found"
            EventTypeDescLen
db <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Marker
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventTypeDescLen
db EventTypeDescLen -> EventTypeDescLen -> Bool
forall a. Eq a => a -> a -> Bool
/= EVENT_DATA_BEGIN) $
                  String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"My Data begin marker not found"
            Header -> Get Header
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ [EventType] -> Header
Header [EventType]
ets
     where
      getEventTypes :: Get [EventType]
      getEventTypes :: Get [EventType]
getEventTypes = do
          EventTypeDescLen
m <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Marker
          case EventTypeDescLen
m of
             EVENT_ET_BEGIN -> do
                  et <- getEventType
                  nextET <- getEventTypes
                  return (et : nextET)
             EVENT_HET_END ->
                  return []
             EventTypeDescLen
_ ->
                  String -> Get [EventType]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Malformed list of Event Types in header"

getEvent :: EventParsers -> Get (Maybe Event)
getEvent :: EventParsers -> Get (Maybe Event)
getEvent (EventParsers Array Int (Get EventInfo)
parsers) = do
  EventTypeNum
etRef <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get EventTypeNum
  if EventTypeNum
etRef EventTypeNum -> EventTypeNum -> Bool
forall a. Eq a => a -> a -> Bool
== EVENT_DATA_END
     then Maybe Event -> Get (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
     else do !Timestamp
evTime   <- Get Timestamp
forall t. Binary t => Get t
get
             EventInfo
evSpec <- Array Int (Get EventInfo)
parsers Array Int (Get EventInfo) -> Int -> Get EventInfo
forall i e. Ix i => Array i e -> i -> e
! EventTypeNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeNum
etRef
             Maybe Event -> Get (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Event -> Get (Maybe Event))
-> Maybe Event -> Get (Maybe Event)
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Event
forall a. a -> Maybe a
Just Event :: Timestamp -> EventInfo -> Maybe Int -> Event
Event { evCap :: Maybe Int
evCap = Maybe Int
forall a. HasCallStack => a
undefined, Timestamp
EventInfo
evSpec :: EventInfo
evTime :: Timestamp
evSpec :: EventInfo
evTime :: Timestamp
.. }

--
-- standardEventParsers.
--
standardParsers :: [EventParser EventInfo]
standardParsers :: [EventParser EventInfo]
standardParsers = [
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STARTUP sz_cap (do -- (n_caps)
      c <- get :: Get CapNo
      return Startup{ n_caps = fromIntegral c }
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_BLOCK_MARKER (sz_block_size + sz_time + sz_cap) (do -- (size, end_time, cap)
      block_size <- get :: Get BlockSize
      end_time <- get :: Get Timestamp
      c <- get :: Get CapNo
      return EventBlock { end_time   = end_time,
                          cap        = fromIntegral c,
                          block_size = ((fromIntegral block_size) -
                                        (fromIntegral sz_block_event))
                        }
   )),

 -- EVENT_SHUTDOWN is replaced by EVENT_CAP_DELETE and GHC 7.6+
 -- no longer generate the event; should be removed at some point
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_SHUTDOWN Shutdown),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_REQUEST_SEQ_GC RequestSeqGC),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_REQUEST_PAR_GC RequestParGC),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_GC_START StartGC),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_GC_WORK GCWork),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_GC_IDLE GCIdle),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_GC_DONE GCDone),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_GC_END EndGC),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_GC_GLOBAL_SYNC GlobalSyncGC),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_GC_STATS_GHC (sz_capset + 2 + 5*8 + 4) (do  -- (heap_capset, generation, copied_bytes, slop_bytes, frag_bytes, par_n_threads, par_max_copied, par_tot_copied)
      EventTypeDescLen
heapCapset   <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
gen          <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get Word16
      Timestamp
copied       <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      Timestamp
slop         <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      Timestamp
frag         <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      EventTypeDescLen
parNThreads  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Word32
      Timestamp
parMaxCopied <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      Timestamp
parTotCopied <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return GCStatsGHC :: EventTypeDescLen
-> Int
-> Timestamp
-> Timestamp
-> Timestamp
-> Int
-> Timestamp
-> Timestamp
-> Maybe Timestamp
-> EventInfo
GCStatsGHC{ gen :: Int
gen = EventTypeNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeNum
gen
                       , parNThreads :: Int
parNThreads = EventTypeDescLen -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeDescLen
parNThreads
                       , parBalancedCopied :: Maybe Timestamp
parBalancedCopied = Maybe Timestamp
forall a. Maybe a
Nothing
                       , EventTypeDescLen
Timestamp
parTotCopied :: Timestamp
parMaxCopied :: Timestamp
frag :: Timestamp
slop :: Timestamp
copied :: Timestamp
heapCapset :: EventTypeDescLen
parTotCopied :: Timestamp
parMaxCopied :: Timestamp
frag :: Timestamp
slop :: Timestamp
copied :: Timestamp
heapCapset :: EventTypeDescLen
..}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_GC_STATS_GHC (sz_capset + 2 + 5*8 + 4 + 8) (do  -- (heap_capset, generation, copied_bytes, slop_bytes, frag_bytes, par_n_threads, par_max_copied, par_tot_copied, par_balanced_copied)
      EventTypeDescLen
heapCapset   <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
gen          <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get Word16
      Timestamp
copied       <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      Timestamp
slop         <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      Timestamp
frag         <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      EventTypeDescLen
parNThreads  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get Word32
      Timestamp
parMaxCopied <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      Timestamp
parTotCopied <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      Timestamp
parBalancedCopied <- Get Timestamp
forall t. Binary t => Get t
get :: Get Word64
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return GCStatsGHC :: EventTypeDescLen
-> Int
-> Timestamp
-> Timestamp
-> Timestamp
-> Int
-> Timestamp
-> Timestamp
-> Maybe Timestamp
-> EventInfo
GCStatsGHC{ gen :: Int
gen = EventTypeNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeNum
gen
                       , parNThreads :: Int
parNThreads = EventTypeDescLen -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeDescLen
parNThreads
                       , parBalancedCopied :: Maybe Timestamp
parBalancedCopied = Timestamp -> Maybe Timestamp
forall a. a -> Maybe a
Just Timestamp
parBalancedCopied
                       , EventTypeDescLen
Timestamp
parTotCopied :: Timestamp
parMaxCopied :: Timestamp
frag :: Timestamp
slop :: Timestamp
copied :: Timestamp
heapCapset :: EventTypeDescLen
parTotCopied :: Timestamp
parMaxCopied :: Timestamp
frag :: Timestamp
slop :: Timestamp
copied :: Timestamp
heapCapset :: EventTypeDescLen
..}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_HEAP_ALLOCATED (sz_capset + 8) (do  -- (heap_capset, alloc_bytes)
      heapCapset <- get
      allocBytes <- get
      return HeapAllocated{..}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_HEAP_SIZE (sz_capset + 8) (do  -- (heap_capset, size_bytes)
      heapCapset <- get
      sizeBytes  <- get
      return HeapSize{..}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_HEAP_LIVE (sz_capset + 8) (do  -- (heap_capset, live_bytes)
      heapCapset <- get
      liveBytes  <- get
      return HeapLive{..}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_HEAP_INFO_GHC (sz_capset + 2 + 4*8) (do  -- (heap_capset, n_generations, max_heap_size, alloc_area_size, mblock_size, block_size)
      heapCapset    <- get
      gens          <- get :: Get Word16
      maxHeapSize   <- get :: Get Word64
      allocAreaSize <- get :: Get Word64
      mblockSize    <- get :: Get Word64
      blockSize     <- get :: Get Word64
      return HeapInfoGHC{gens = fromIntegral gens, ..}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAP_CREATE (sz_cap) (do  -- (cap)
      cap <- get :: Get CapNo
      return CapCreate{cap = fromIntegral cap}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAP_DELETE (sz_cap) (do  -- (cap)
      cap <- get :: Get CapNo
      return CapDelete{cap = fromIntegral cap}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAP_DISABLE (sz_cap) (do  -- (cap)
      cap <- get :: Get CapNo
      return CapDisable{cap = fromIntegral cap}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAP_ENABLE (sz_cap) (do  -- (cap)
      cap <- get :: Get CapNo
      return CapEnable{cap = fromIntegral cap}
 )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAPSET_CREATE (sz_capset + sz_capset_type) (do -- (capset, capset_type)
      EventTypeDescLen
cs <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      CapsetType
ct <- (EventTypeNum -> CapsetType) -> Get EventTypeNum -> Get CapsetType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventTypeNum -> CapsetType
mkCapsetType Get EventTypeNum
forall t. Binary t => Get t
get
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CapsetCreate :: EventTypeDescLen -> CapsetType -> EventInfo
CapsetCreate{capset :: EventTypeDescLen
capset=EventTypeDescLen
cs,capsetType :: CapsetType
capsetType=CapsetType
ct}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAPSET_DELETE sz_capset (do -- (capset)
      cs <- get
      return CapsetDelete{capset=cs}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAPSET_ASSIGN_CAP (sz_capset + sz_cap) (do -- (capset, cap)
      EventTypeDescLen
cs <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
cp <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get CapNo
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CapsetAssignCap :: EventTypeDescLen -> Int -> EventInfo
CapsetAssignCap{capset :: EventTypeDescLen
capset=EventTypeDescLen
cs,cap :: Int
cap=EventTypeNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeNum
cp}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CAPSET_REMOVE_CAP (sz_capset + sz_cap) (do -- (capset, cap)
      EventTypeDescLen
cs <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
cp <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get CapNo
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CapsetRemoveCap :: EventTypeDescLen -> Int -> EventInfo
CapsetRemoveCap{capset :: EventTypeDescLen
capset=EventTypeDescLen
cs,cap :: Int
cap=EventTypeNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeNum
cp}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_OSPROCESS_PID (sz_capset + sz_pid) (do -- (capset, pid)
      cs <- get
      pd <- get
      return OsProcessPid{capset=cs,pid=pd}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_OSPROCESS_PPID (sz_capset + sz_pid) (do -- (capset, ppid)
      cs <- get
      pd <- get
      return OsProcessParentPid{capset=cs,ppid=pd}
  )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_WALL_CLOCK_TIME (sz_capset + 8 + 4) (do -- (capset, unix_epoch_seconds, nanoseconds)
      cs <- get
      s  <- get
      ns <- get
      return WallClockTime{capset=cs,sec=s,nsec=ns}
  )),

 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_LOG_MSG (do -- (msg)
      num <- get :: Get Word16
      string <- getText num
      return Message{ msg = string }
   )),
 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_USER_MSG (do -- (msg)
      num <- get :: Get Word16
      string <- getText num
      return UserMessage{ msg = string }
   )),
    (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_USER_MARKER (do -- (markername)
      num <- get :: Get Word16
      string <- getText num
      return UserMarker{ markername = string }
   )),
 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_PROGRAM_ARGS (do -- (capset, [arg])
      num <- get :: Get Word16
      cs <- get
      string <- getText (num - sz_capset)
      return ProgramArgs
        { capset = cs
        , args = T.splitOn "\0" $ T.dropWhileEnd (== '\0') string }
   )),
 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_PROGRAM_ENV (do -- (capset, [arg])
      num <- get :: Get Word16
      cs <- get
      string <- getText (num - sz_capset)
      return ProgramEnv
        { capset = cs
        , env = T.splitOn "\0" $ T.dropWhileEnd (== '\0') string }
   )),
 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_RTS_IDENTIFIER (do -- (capset, str)
      num <- get :: Get Word16
      cs <- get
      string <- getText (num - sz_capset)
      return RtsIdentifier{ capset = cs
                          , rtsident = string }
   )),

 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_INTERN_STRING (do -- (str, id)
      num <- get :: Get Word16
      string <- getString (num - sz_string_id)
      sId <- get :: Get StringId
      return (InternString string sId)
    )),

 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_THREAD_LABEL (do -- (thread, str)
      num <- get :: Get Word16
      tid <- get
      str <- getText (num - sz_tid)
      return ThreadLabel{ thread      = tid
                        , threadlabel = str }
    )),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_CONC_MARK_BEGIN ConcMarkBegin),
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CONC_MARK_END 4 (do -- (marked_object_count)
      num <- get :: Get Word32
      return ConcMarkEnd{ concMarkedObjectCount = num }
    )),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_CONC_SYNC_BEGIN ConcSyncBegin),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_CONC_SYNC_END ConcSyncEnd),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_CONC_SWEEP_BEGIN ConcSweepBegin),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_CONC_SWEEP_END ConcSweepEnd),
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CONC_UPD_REM_SET_FLUSH sz_cap (do -- (cap)
      cap <- get :: Get CapNo
      return ConcUpdRemSetFlush{ cap = fromIntegral cap }
    )),
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_NONMOVING_HEAP_CENSUS 13 (do -- (blk_size, active_segs, filled_segs, live_blks)
      nonmovingCensusBlkSize <- get :: Get Word8
      nonmovingCensusActiveSegs <- get :: Get Word32
      nonmovingCensusFilledSegs <- get :: Get Word32
      nonmovingCensusLiveBlocks <- get :: Get Word32
      return NonmovingHeapCensus{..}
    ))
 ]

-- Parsers valid for GHC7 but not GHC6.
ghc7Parsers :: [EventParser EventInfo]
ghc7Parsers :: [EventParser EventInfo]
ghc7Parsers = [
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CREATE_THREAD sz_tid (do  -- (thread)
      t <- get
      return CreateThread{thread=t}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_RUN_THREAD sz_tid (do  --  (thread)
      t <- get
      return RunThread{thread=t}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_THREAD_RUNNABLE sz_tid (do  -- (thread)
      t <- get
      return ThreadRunnable{thread=t}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MIGRATE_THREAD (sz_tid + sz_cap) (do  --  (thread, newCap)
      EventTypeDescLen
t  <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
nc <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get CapNo
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return MigrateThread :: EventTypeDescLen -> Int -> EventInfo
MigrateThread{thread :: EventTypeDescLen
thread=EventTypeDescLen
t,newCap :: Int
newCap=EventTypeNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeNum
nc}
   )),

 -- Yes, EVENT_RUN/STEAL_SPARK are deprecated, but see the explanation in the
 -- 'ghc6Parsers' section below. Since we're parsing them anyway, we might
 -- as well convert them to the new SparkRun/SparkSteal events.
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_RUN_SPARK sz_tid (do  -- (thread)
      _ <- get :: Get ThreadId
      return SparkRun
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STEAL_SPARK (sz_tid + sz_cap) (do  -- (thread, victimCap)
      _  <- get :: Get ThreadId
      vc <- get :: Get CapNo
      return SparkSteal{victimCap=fromIntegral vc}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CREATE_SPARK_THREAD sz_tid (do  -- (sparkThread)
      st <- get :: Get ThreadId
      return CreateSparkThread{sparkThread=st}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_SPARK_COUNTERS (7*8) (do -- (crt,dud,ovf,cnv,gcd,fiz,rem)
      crt <- get :: Get Word64
      dud <- get :: Get Word64
      ovf <- get :: Get Word64
      cnv <- get :: Get Word64
      gcd <- get :: Get Word64
      fiz <- get :: Get Word64
      rem <- get :: Get Word64
      return SparkCounters{sparksCreated    = crt, sparksDud       = dud,
                           sparksOverflowed = ovf, sparksConverted = cnv,
                           -- Warning: order of fiz and gcd reversed!
                           sparksFizzled    = fiz, sparksGCd       = gcd,
                           sparksRemaining  = rem}
   )),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_SPARK_CREATE   SparkCreate),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_SPARK_DUD      SparkDud),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_SPARK_OVERFLOW SparkOverflow),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_SPARK_RUN      SparkRun),
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_SPARK_STEAL sz_cap (do  -- (victimCap)
      vc <- get :: Get CapNo
      return SparkSteal{victimCap=fromIntegral vc}
   )),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_SPARK_FIZZLE   SparkFizzle),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_SPARK_GC       SparkGC),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_TASK_CREATE (sz_taskid + sz_cap + sz_kernel_tid) (do  -- (taskID, cap, tid)
      taskId <- get :: Get TaskId
      cap    <- get :: Get CapNo
      tid    <- get :: Get KernelThreadId
      return TaskCreate{ taskId, cap = fromIntegral cap, tid }
   )),
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_TASK_MIGRATE (sz_taskid + sz_cap*2) (do  -- (taskID, cap, new_cap)
      taskId  <- get :: Get TaskId
      cap     <- get :: Get CapNo
      new_cap <- get :: Get CapNo
      return TaskMigrate{ taskId, cap = fromIntegral cap
                                , new_cap = fromIntegral new_cap
                        }
   )),
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_TASK_DELETE (sz_taskid) (do  -- (taskID)
      taskId <- get :: Get TaskId
      return TaskDelete{ taskId }
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_THREAD_WAKEUP (sz_tid + sz_cap) (do  -- (thread, other_cap)
      EventTypeDescLen
t <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
oc <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get CapNo
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return WakeupThread :: EventTypeDescLen -> Int -> EventInfo
WakeupThread{thread :: EventTypeDescLen
thread=EventTypeDescLen
t,otherCap :: Int
otherCap=EventTypeNum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventTypeNum
oc}
   ))
 ]

-- special thread stop event parsers for GHC version 7.8.2
-- see [Stop status in GHC-7.8.2] in EventTypes.hs
ghc782StopParser :: EventParser EventInfo
ghc782StopParser :: EventParser EventInfo
ghc782StopParser =
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid) (do
      -- (thread, status, info)
      t <- get
      s <- get :: Get RawThreadStopStatus
      i <- get :: Get ThreadId
      return StopThread{thread = t,
                        status = case () of
                                  _ | s > maxThreadStopStatus782
                                    -> NoStatus
                                    | s == 9 {- XXX yeuch -}
                                      -- GHC-7.8.2: 9 == BlockedOnBlackHole
                                    -> BlockedOnBlackHoleOwnedBy i
                                    | otherwise
                                    -> mkStopStatus782 s}
   ))

-- parsers for GHC < 7.8.2. Older versions do not use block info
-- (different length).  See [Stop status in GHC-7.8.2] in
-- EventTypes.hs
pre77StopParsers :: [EventParser EventInfo]
pre77StopParsers :: [EventParser EventInfo]
pre77StopParsers = [
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status) (do
      -- (thread, status)
      t <- get
      s <- get :: Get RawThreadStopStatus
      return StopThread{thread=t, status = if s > maxThreadStopStatusPre77
                                              then NoStatus
                                              else mkStopStatus s}
                        -- older version of the event, no block info
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid)
    (do
      -- (thread, status, info)
      EventTypeDescLen
t <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
s <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get RawThreadStopStatus
      EventTypeDescLen
i <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ThreadId
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return StopThread :: EventTypeDescLen -> ThreadStopStatus -> EventInfo
StopThread{thread :: EventTypeDescLen
thread = EventTypeDescLen
t,
                        status :: ThreadStopStatus
status = case () of
                                  ()
_ | EventTypeNum
s EventTypeNum -> EventTypeNum -> Bool
forall a. Ord a => a -> a -> Bool
> EventTypeNum
maxThreadStopStatusPre77
                                    -> ThreadStopStatus
NoStatus
                                    | EventTypeNum
s EventTypeNum -> EventTypeNum -> Bool
forall a. Eq a => a -> a -> Bool
== EventTypeNum
8 {- XXX yeuch -}
                                      -- pre-7.7: 8==BlockedOnBlackhole
                                    -> EventTypeDescLen -> ThreadStopStatus
BlockedOnBlackHoleOwnedBy EventTypeDescLen
i
                                    | Bool
otherwise
                                    -> EventTypeNum -> ThreadStopStatus
mkStopStatus EventTypeNum
s}
    ))
  ]

-- parsers for GHC >= 7.8.3, always using block info field parser.
-- See [Stop status in GHC-7.8.2] in EventTypes.hs
post782StopParser :: EventParser EventInfo
post782StopParser :: EventParser EventInfo
post782StopParser =
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid)
    (do
      -- (thread, status, info)
      EventTypeDescLen
t <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      EventTypeNum
s <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get RawThreadStopStatus
      EventTypeDescLen
i <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ThreadId
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return StopThread :: EventTypeDescLen -> ThreadStopStatus -> EventInfo
StopThread{thread :: EventTypeDescLen
thread = EventTypeDescLen
t,
                        status :: ThreadStopStatus
status = case () of
                                  ()
_ | EventTypeNum
s EventTypeNum -> EventTypeNum -> Bool
forall a. Ord a => a -> a -> Bool
> EventTypeNum
maxThreadStopStatus
                                    -> ThreadStopStatus
NoStatus
                                    | EventTypeNum
s EventTypeNum -> EventTypeNum -> Bool
forall a. Eq a => a -> a -> Bool
== EventTypeNum
8 {- XXX yeuch -}
                                      -- post-7.8.2: 8==BlockedOnBlackhole
                                    -> EventTypeDescLen -> ThreadStopStatus
BlockedOnBlackHoleOwnedBy EventTypeDescLen
i
                                    | Bool
otherwise
                                    -> EventTypeNum -> ThreadStopStatus
mkStopStatus EventTypeNum
s}
    ))

 -----------------------
 -- GHC 6.12 compat: GHC 6.12 reported the wrong sizes for some events,
 -- so we have to recognise those wrong sizes here for backwards
 -- compatibility.
ghc6Parsers :: [EventParser EventInfo]
ghc6Parsers :: [EventParser EventInfo]
ghc6Parsers = [
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STARTUP 0 (do
      -- BUG in GHC 6.12: the startup event was incorrectly
      -- declared as size 0, so we accept it here.
      c <- get :: Get CapNo
      return Startup{ n_caps = fromIntegral c }
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CREATE_THREAD sz_old_tid (do  -- (thread)
      t <- get
      return CreateThread{thread=t}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_RUN_THREAD sz_old_tid (do  --  (thread)
      t <- get
      return RunThread{thread=t}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STOP_THREAD (sz_old_tid + 2) (do  -- (thread, status)
      t <- get
      s <- get :: Get RawThreadStopStatus
      return StopThread{thread=t, status = if s > maxThreadStopStatusPre77
                                              then NoStatus
                                              else mkStopStatus s}
                        -- older version of the event uses pre-77 encoding
                        -- (actually, it only uses encodings 0 to 5)
                        -- see [Stop status in GHC-7.8.2] in EventTypes.hs
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_THREAD_RUNNABLE sz_old_tid (do  -- (thread)
      t <- get
      return ThreadRunnable{thread=t}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MIGRATE_THREAD (sz_old_tid + sz_cap) (do  --  (thread, newCap)
      t  <- get
      nc <- get :: Get CapNo
      return MigrateThread{thread=t,newCap=fromIntegral nc}
   )),

 -- Note: it is vital that these two (EVENT_RUN/STEAL_SPARK) remain here (at
 -- least in the ghc6Parsers section) even though both events are deprecated.
 -- The reason is that .eventlog files created by the buggy GHC-6.12
 -- mis-declare the size of these two events. So we have to handle them
 -- specially here otherwise we'll get the wrong size, leading to us getting
 -- out of sync and eventual parse failure. Since we're parsing them anyway,
 -- we might as well convert them to the new SparkRun/SparkSteal events.
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_RUN_SPARK sz_old_tid (do  -- (thread)
      _ <- get :: Get ThreadId
      return SparkRun
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_STEAL_SPARK (sz_old_tid + sz_cap) (do  -- (thread, victimCap)
      _  <- get :: Get ThreadId
      vc <- get :: Get CapNo
      return SparkSteal{victimCap=fromIntegral vc}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CREATE_SPARK_THREAD sz_old_tid (do  -- (sparkThread)
      st <- get :: Get ThreadId
      return CreateSparkThread{sparkThread=st}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_THREAD_WAKEUP (sz_old_tid + sz_cap) (do  -- (thread, other_cap)
      t <- get
      oc <- get :: Get CapNo
      return WakeupThread{thread=t,otherCap=fromIntegral oc}
   ))
 ]

-- Parsers for parallel events. Parameter is the thread_id size, to create
-- ghc6-parsers (using the wrong size) where necessary.
parRTSParsers :: EventTypeSize -> [EventParser EventInfo]
parRTSParsers :: EventTypeNum -> [EventParser EventInfo]
parRTSParsers EventTypeNum
sz_tid' = [
 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_VERSION (do -- (version)
      num <- get :: Get Word16
      string <- getString num
      return Version{ version = string }
   )),

 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_PROGRAM_INVOCATION (do -- (cmd. line)
      num <- get :: Get Word16
      string <- getString num
      return ProgramInvocation{ commandline = string }
   )),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_EDEN_START_RECEIVE EdenStartReceive),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_EDEN_END_RECEIVE   EdenEndReceive),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CREATE_PROCESS sz_procid
    (do EventTypeDescLen
p <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CreateProcess :: EventTypeDescLen -> EventInfo
CreateProcess{ process :: EventTypeDescLen
process = EventTypeDescLen
p })
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_KILL_PROCESS sz_procid
    (do EventTypeDescLen
p <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return KillProcess :: EventTypeDescLen -> EventInfo
KillProcess{ process :: EventTypeDescLen
process = EventTypeDescLen
p })
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_ASSIGN_THREAD_TO_PROCESS (sz_tid' + sz_procid)
    (do EventTypeDescLen
t <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventTypeDescLen
p <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AssignThreadToProcess :: EventTypeDescLen -> EventTypeDescLen -> EventInfo
AssignThreadToProcess { thread :: EventTypeDescLen
thread = EventTypeDescLen
t, process :: EventTypeDescLen
process = EventTypeDescLen
p })
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_CREATE_MACHINE (sz_mid + sz_realtime)
    (do EventTypeNum
m <- Get EventTypeNum
forall t. Binary t => Get t
get
        Timestamp
t <- Get Timestamp
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CreateMachine :: EventTypeNum -> Timestamp -> EventInfo
CreateMachine { machine :: EventTypeNum
machine = EventTypeNum
m, realtime :: Timestamp
realtime = Timestamp
t })
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_KILL_MACHINE sz_mid
    (do EventTypeNum
m <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get MachineId
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return KillMachine :: EventTypeNum -> EventInfo
KillMachine { machine :: EventTypeNum
machine = EventTypeNum
m })
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_SEND_MESSAGE
    (EventTypeNum
sz_msgtag EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
2EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
*EventTypeNum
sz_procid EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
2EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
*EventTypeNum
sz_tid' EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_mid)
    (do Word8
tag <- Get Word8
forall t. Binary t => Get t
get :: Get RawMsgTag
        EventTypeDescLen
sP  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ProcessId
        EventTypeDescLen
sT  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ThreadId
        EventTypeNum
rM  <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get MachineId
        EventTypeDescLen
rP  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ProcessId
        EventTypeDescLen
rIP <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get PortId
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SendMessage :: MessageTag
-> EventTypeDescLen
-> EventTypeDescLen
-> EventTypeNum
-> EventTypeDescLen
-> EventTypeDescLen
-> EventInfo
SendMessage { mesTag :: MessageTag
mesTag = Word8 -> MessageTag
toMsgTag Word8
tag,
                             senderProcess :: EventTypeDescLen
senderProcess = EventTypeDescLen
sP,
                             senderThread :: EventTypeDescLen
senderThread = EventTypeDescLen
sT,
                             receiverMachine :: EventTypeNum
receiverMachine = EventTypeNum
rM,
                             receiverProcess :: EventTypeDescLen
receiverProcess = EventTypeDescLen
rP,
                             receiverInport :: EventTypeDescLen
receiverInport = EventTypeDescLen
rIP
                           })
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_RECEIVE_MESSAGE
    (EventTypeNum
sz_msgtag EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
2EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
*EventTypeNum
sz_procid EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
2EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
*EventTypeNum
sz_tid' EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_mid EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_mes)
    (do Word8
tag <- Get Word8
forall t. Binary t => Get t
get :: Get Word8
        EventTypeDescLen
rP  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ProcessId
        EventTypeDescLen
rIP <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get PortId
        EventTypeNum
sM  <- Get EventTypeNum
forall t. Binary t => Get t
get :: Get MachineId
        EventTypeDescLen
sP  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ProcessId
        EventTypeDescLen
sT  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ThreadId
        EventTypeDescLen
mS  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get MessageSize
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return  ReceiveMessage :: MessageTag
-> EventTypeDescLen
-> EventTypeDescLen
-> EventTypeNum
-> EventTypeDescLen
-> EventTypeDescLen
-> EventTypeDescLen
-> EventInfo
ReceiveMessage { mesTag :: MessageTag
mesTag = Word8 -> MessageTag
toMsgTag Word8
tag,
                                 receiverProcess :: EventTypeDescLen
receiverProcess = EventTypeDescLen
rP,
                                 receiverInport :: EventTypeDescLen
receiverInport = EventTypeDescLen
rIP,
                                 senderMachine :: EventTypeNum
senderMachine = EventTypeNum
sM,
                                 senderProcess :: EventTypeDescLen
senderProcess = EventTypeDescLen
sP,
                                 senderThread :: EventTypeDescLen
senderThread= EventTypeDescLen
sT,
                                 messageSize :: EventTypeDescLen
messageSize = EventTypeDescLen
mS
                               })
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_SEND_RECEIVE_LOCAL_MESSAGE
    (EventTypeNum
sz_msgtag EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
2EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
*EventTypeNum
sz_procid EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
2EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
*EventTypeNum
sz_tid')
    (do Word8
tag <- Get Word8
forall t. Binary t => Get t
get :: Get Word8
        EventTypeDescLen
sP  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ProcessId
        EventTypeDescLen
sT  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ThreadId
        EventTypeDescLen
rP  <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get ProcessId
        EventTypeDescLen
rIP <- Get EventTypeDescLen
forall t. Binary t => Get t
get :: Get PortId
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SendReceiveLocalMessage :: MessageTag
-> EventTypeDescLen
-> EventTypeDescLen
-> EventTypeDescLen
-> EventTypeDescLen
-> EventInfo
SendReceiveLocalMessage { mesTag :: MessageTag
mesTag = Word8 -> MessageTag
toMsgTag Word8
tag,
                                         senderProcess :: EventTypeDescLen
senderProcess = EventTypeDescLen
sP,
                                         senderThread :: EventTypeDescLen
senderThread = EventTypeDescLen
sT,
                                         receiverProcess :: EventTypeDescLen
receiverProcess = EventTypeDescLen
rP,
                                         receiverInport :: EventTypeDescLen
receiverInport = EventTypeDescLen
rIP
                                       })
 )]

mercuryParsers :: [EventParser EventInfo]
mercuryParsers :: [EventParser EventInfo]
mercuryParsers = [
 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_START_PAR_CONJUNCTION
    (EventTypeNum
sz_par_conj_dyn_id EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_par_conj_static_id)
    (do Timestamp
dyn_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventTypeDescLen
static_id <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventTypeDescLen -> EventInfo
MerStartParConjunction Timestamp
dyn_id EventTypeDescLen
static_id))
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_STOP_PAR_CONJUNCTION sz_par_conj_dyn_id
    (do Timestamp
dyn_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventInfo
MerEndParConjunction Timestamp
dyn_id))
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_STOP_PAR_CONJUNCT sz_par_conj_dyn_id
    (do Timestamp
dyn_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventInfo
MerEndParConjunct Timestamp
dyn_id))
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_CREATE_SPARK (sz_par_conj_dyn_id + sz_spark_id)
    (do Timestamp
dyn_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventTypeDescLen
spark_id <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventTypeDescLen -> EventInfo
MerCreateSpark Timestamp
dyn_id EventTypeDescLen
spark_id))
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_FUT_CREATE (sz_future_id + sz_string_id)
    (do Timestamp
future_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventTypeDescLen
name_id <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventTypeDescLen -> EventInfo
MerFutureCreate Timestamp
future_id EventTypeDescLen
name_id))
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_FUT_WAIT_NOSUSPEND (sz_future_id)
    (do Timestamp
future_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventInfo
MerFutureWaitNosuspend Timestamp
future_id))
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_FUT_WAIT_SUSPENDED (sz_future_id)
    (do Timestamp
future_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventInfo
MerFutureWaitSuspended Timestamp
future_id))
 ),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_FUT_SIGNAL (sz_future_id)
    (do Timestamp
future_id <- Get Timestamp
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> EventInfo
MerFutureSignal Timestamp
future_id))
 ),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_MER_LOOKING_FOR_GLOBAL_CONTEXT MerLookingForGlobalThread),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_MER_WORK_STEALING MerWorkStealing),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_MER_LOOKING_FOR_LOCAL_SPARK MerLookingForLocalSpark),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_MER_RELEASE_CONTEXT sz_tid
    (do EventTypeDescLen
thread_id <- Get EventTypeDescLen
forall t. Binary t => Get t
get
        EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (EventTypeDescLen -> EventInfo
MerReleaseThread EventTypeDescLen
thread_id))
 ),

 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_MER_ENGINE_SLEEPING MerCapSleeping),
 (Int -> EventInfo -> EventParser EventInfo
forall a. Int -> a -> EventParser a
simpleEvent EVENT_MER_CALLING_MAIN MerCallingMain)

 ]

perfParsers :: [EventParser EventInfo]
perfParsers :: [EventParser EventInfo]
perfParsers = [
 (Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_PERF_NAME (do -- (perf_num, name)
      num     <- get :: Get Word16
      perfNum <- get
      name    <- getText (num - sz_perf_num)
      return PerfName{perfNum, name}
   )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_PERF_COUNTER (sz_perf_num + sz_kernel_tid + 8) (do -- (perf_num, tid, period)
      perfNum <- get
      tid     <- get
      period  <- get
      return PerfCounter{perfNum, tid, period}
  )),

 (Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_PERF_TRACEPOINT (sz_perf_num + sz_kernel_tid) (do -- (perf_num, tid)
      EventTypeDescLen
perfNum <- Get EventTypeDescLen
forall t. Binary t => Get t
get
      KernelThreadId
tid     <- Get KernelThreadId
forall t. Binary t => Get t
get
      EventInfo -> Get EventInfo
forall (m :: * -> *) a. Monad m => a -> m a
return PerfTracepoint :: EventTypeDescLen -> KernelThreadId -> EventInfo
PerfTracepoint{EventTypeDescLen
perfNum :: EventTypeDescLen
perfNum :: EventTypeDescLen
perfNum, KernelThreadId
tid :: KernelThreadId
tid :: KernelThreadId
tid}
  ))
 ]

heapProfParsers :: [EventParser EventInfo]
heapProfParsers :: [EventParser EventInfo]
heapProfParsers =
  [ Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_HEAP_PROF_BEGIN $ do
    payloadLen <- get :: Get Word16
    heapProfId <- get
    heapProfSamplingPeriod <- get
    heapProfBreakdown <- get
    heapProfModuleFilter <- getTextNul
    heapProfClosureDescrFilter <- getTextNul
    heapProfTypeDescrFilter <- getTextNul
    heapProfCostCentreFilter <- getTextNul
    heapProfCostCentreStackFilter <- getTextNul
    heapProfRetainerFilter <- getTextNul
    heapProfBiographyFilter <- getTextNul
    assert
      (fromIntegral payloadLen == sum
        [ 1 -- heapProfId
        , 8 -- heapProfSamplingPeriod
        , 4 -- heapProfBreakdown
        , textByteLen heapProfModuleFilter
        , textByteLen heapProfClosureDescrFilter
        , textByteLen heapProfTypeDescrFilter
        , textByteLen heapProfCostCentreFilter
        , textByteLen heapProfCostCentreStackFilter
        , textByteLen heapProfRetainerFilter
        , textByteLen heapProfBiographyFilter
        ])
      (return ())
    return $! HeapProfBegin {..}
  , Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_HEAP_PROF_COST_CENTRE $ do
    payloadLen <- get :: Get Word16
    heapProfCostCentreId <- get
    heapProfLabel <- getTextNul
    heapProfModule <- getTextNul
    heapProfSrcLoc <- getTextNul
    heapProfFlags <- get
    assert
      (fromIntegral payloadLen == sum
        [ 4 -- heapProfCostCentreId
        , textByteLen heapProfLabel
        , textByteLen heapProfModule
        , textByteLen heapProfSrcLoc
        , 1 -- heapProfFlags
        ])
      (return ())
    return $! HeapProfCostCentre {..}
  , Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_HEAP_PROF_SAMPLE_BEGIN 8 $ do
    heapProfSampleEra <- get
    return $! HeapProfSampleBegin {..}
  , Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_HEAP_PROF_SAMPLE_END 8 $ do
    heapProfSampleEra <- get
    return $! HeapProfSampleEnd {..}
  , Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_HEAP_BIO_PROF_SAMPLE_BEGIN 16 $ do
    heapProfSampleEra <- get
    heapProfSampleTime <- get
    return $! HeapBioProfSampleBegin {..}
  , Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_HEAP_PROF_SAMPLE_COST_CENTRE $ do
    payloadLen <- get :: Get Word16
    heapProfId <- get
    heapProfResidency <- get
    heapProfStackDepth <- get
    heapProfStack <- VU.replicateM (fromIntegral heapProfStackDepth) get
    assert
      ((fromIntegral payloadLen :: Int) == sum
        [ 1 -- heapProfId
        , 8 -- heapProfResidency
        , 1 -- heapProfStackDepth
        , fromIntegral heapProfStackDepth * 4
        ])
      (return ())
    return $! HeapProfSampleCostCentre {..}
  , Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_HEAP_PROF_SAMPLE_STRING $ do
    payloadLen <- get :: Get Word16
    heapProfId <- get
    heapProfResidency <- get
    heapProfLabel <- getTextNul
    assert
      (fromIntegral payloadLen == sum
        [ 1 -- heapProfId
        , 8 -- heapProfResidency
        , textByteLen heapProfLabel
        ])
      (return ())
    return $! HeapProfSampleString {..}
  ]

timeProfParsers :: [EventParser EventInfo]
timeProfParsers :: [EventParser EventInfo]
timeProfParsers = [
  Int -> EventTypeNum -> Get EventInfo -> EventParser EventInfo
forall a. Int -> EventTypeNum -> Get a -> EventParser a
FixedSizeParser EVENT_PROF_BEGIN 8 $ do
    profTickInterval <- get
    return $! ProfBegin{..}
  , Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_PROF_SAMPLE_COST_CENTRE $ do
    payloadLen <- get :: Get Word16
    profCapset <- get
    profTicks <- get
    profStackDepth <- get
    profCcsStack <- VU.replicateM (fromIntegral profStackDepth) get
    assert
      ((fromIntegral payloadLen :: Int) == sum
        [ 4
        , 8 -- ticks
        , 1 -- stack depth
        , fromIntegral profStackDepth * 4
        ])
      (return ())
    return $! ProfSampleCostCentre {..} ]

binaryEventParsers :: [EventParser EventInfo]
binaryEventParsers :: [EventParser EventInfo]
binaryEventParsers =
  [ Int -> Get EventInfo -> EventParser EventInfo
forall a. Int -> Get a -> EventParser a
VariableSizeParser EVENT_USER_BINARY_MSG $ do
    payloadLen <- get :: Get Word16
    payload <- G.getByteString $ fromIntegral payloadLen
    return $! UserBinaryMessage { payload }
  ]

-- | String byte length in the eventlog format. It includes
-- 1 byte for NUL.
textByteLen :: T.Text -> Int
textByteLen :: Text -> Int
textByteLen = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> Int) -> (Text -> ByteString) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

-----------------------------------------------------------

putE :: Binary a => a -> PutM ()
putE :: a -> PutM ()
putE = a -> PutM ()
forall t. Binary t => t -> PutM ()
put

putType :: EventTypeNum -> PutM ()
putType :: EventTypeNum -> PutM ()
putType = EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE

putCap :: Int -> PutM ()
putCap :: Int -> PutM ()
putCap Int
c = EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c :: CapNo)

putMarker :: Word32 -> PutM ()
putMarker :: EventTypeDescLen -> PutM ()
putMarker = EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE

putEventLog :: EventLog -> PutM ()
putEventLog :: EventLog -> PutM ()
putEventLog (EventLog Header
hdr Data
es) = do
    Header -> PutM ()
putHeader Header
hdr
    Data -> PutM ()
putData Data
es

putHeader :: Header -> PutM ()
putHeader :: Header -> PutM ()
putHeader (Header [EventType]
ets) = do
    EventTypeDescLen -> PutM ()
putMarker EVENT_HEADER_BEGIN
    EventTypeDescLen -> PutM ()
putMarker EVENT_HET_BEGIN
    (EventType -> PutM ()) -> [EventType] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EventType -> PutM ()
putEventType [EventType]
ets
    EventTypeDescLen -> PutM ()
putMarker EVENT_HET_END
    EventTypeDescLen -> PutM ()
putMarker EVENT_HEADER_END
 where
    putEventType :: EventType -> PutM ()
putEventType (EventType EventTypeNum
n (Text -> ByteString
TE.encodeUtf8 -> ByteString
d) Maybe EventTypeNum
msz) = do
        EventTypeDescLen -> PutM ()
putMarker EVENT_ET_BEGIN
        EventTypeNum -> PutM ()
putType EventTypeNum
n
        EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (EventTypeNum -> PutM ()) -> EventTypeNum -> PutM ()
forall a b. (a -> b) -> a -> b
$ EventTypeNum -> Maybe EventTypeNum -> EventTypeNum
forall a. a -> Maybe a -> a
fromMaybe EventTypeNum
0xffff Maybe EventTypeNum
msz
        EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeDescLen
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> EventTypeDescLen) -> Int -> EventTypeDescLen
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
d :: EventTypeDescLen)
        ByteString -> PutM ()
putByteString ByteString
d
        -- the event type header allows for extra data, which we don't use:
        EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE (EventTypeDescLen
0 :: Word32)
        EventTypeDescLen -> PutM ()
putMarker EVENT_ET_END

putData :: Data -> PutM ()
putData :: Data -> PutM ()
putData (Data [Event]
es) = do
    EventTypeDescLen -> PutM ()
putMarker EVENT_DATA_BEGIN -- Word32
    (Event -> PutM ()) -> [Event] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Event -> PutM ()
putEvent [Event]
es
    EventTypeNum -> PutM ()
putType EVENT_DATA_END -- Word16

eventTypeNum :: EventInfo -> EventTypeNum
eventTypeNum :: EventInfo -> EventTypeNum
eventTypeNum EventInfo
e = case EventInfo
e of
    CreateThread {} -> EVENT_CREATE_THREAD
    RunThread {} -> EVENT_RUN_THREAD
    StopThread {} -> EVENT_STOP_THREAD
    ThreadRunnable {} -> EVENT_THREAD_RUNNABLE
    MigrateThread {} -> EVENT_MIGRATE_THREAD
    Shutdown {} -> EVENT_SHUTDOWN
    WakeupThread {} -> EVENT_THREAD_WAKEUP
    ThreadLabel {}  -> EVENT_THREAD_LABEL
    StartGC {} -> EVENT_GC_START
    EndGC {} -> EVENT_GC_END
    GlobalSyncGC {} -> EVENT_GC_GLOBAL_SYNC
    RequestSeqGC {} -> EVENT_REQUEST_SEQ_GC
    RequestParGC {} -> EVENT_REQUEST_PAR_GC
    CreateSparkThread {} -> EVENT_CREATE_SPARK_THREAD
    SparkCounters {} -> EVENT_SPARK_COUNTERS
    SparkCreate   {} -> EVENT_SPARK_CREATE
    SparkDud      {} -> EVENT_SPARK_DUD
    SparkOverflow {} -> EVENT_SPARK_OVERFLOW
    SparkRun      {} -> EVENT_SPARK_RUN
    SparkSteal    {} -> EVENT_SPARK_STEAL
    SparkFizzle   {} -> EVENT_SPARK_FIZZLE
    SparkGC       {} -> EVENT_SPARK_GC
    TaskCreate  {} -> EVENT_TASK_CREATE
    TaskMigrate {} -> EVENT_TASK_MIGRATE
    TaskDelete  {} -> EVENT_TASK_DELETE
    Message {} -> EVENT_LOG_MSG
    Startup {} -> EVENT_STARTUP
    EventBlock {} -> EVENT_BLOCK_MARKER
    UserMessage {} -> EVENT_USER_MSG
    UserMarker  {} -> EVENT_USER_MARKER
    GCIdle {} -> EVENT_GC_IDLE
    GCWork {} -> EVENT_GC_WORK
    GCDone {} -> EVENT_GC_DONE
    GCStatsGHC{} -> EVENT_GC_STATS_GHC
    HeapAllocated{} -> EVENT_HEAP_ALLOCATED
    HeapSize{} -> EVENT_HEAP_SIZE
    HeapLive{} -> EVENT_HEAP_LIVE
    HeapInfoGHC{} -> EVENT_HEAP_INFO_GHC
    CapCreate{} -> EVENT_CAP_CREATE
    CapDelete{} -> EVENT_CAP_DELETE
    CapDisable{} -> EVENT_CAP_DISABLE
    CapEnable{} -> EVENT_CAP_ENABLE
    CapsetCreate {} -> EVENT_CAPSET_CREATE
    CapsetDelete {} -> EVENT_CAPSET_DELETE
    CapsetAssignCap {} -> EVENT_CAPSET_ASSIGN_CAP
    CapsetRemoveCap {} -> EVENT_CAPSET_REMOVE_CAP
    RtsIdentifier {} -> EVENT_RTS_IDENTIFIER
    ProgramArgs {} -> EVENT_PROGRAM_ARGS
    ProgramEnv {} -> EVENT_PROGRAM_ENV
    OsProcessPid {} -> EVENT_OSPROCESS_PID
    OsProcessParentPid{} -> EVENT_OSPROCESS_PPID
    WallClockTime{} -> EVENT_WALL_CLOCK_TIME
    UnknownEvent {} -> String -> EventTypeNum
forall a. HasCallStack => String -> a
error String
"eventTypeNum UnknownEvent"
    InternString {} -> EVENT_INTERN_STRING
    Version {} -> EVENT_VERSION
    ProgramInvocation {} -> EVENT_PROGRAM_INVOCATION
    EdenStartReceive {} -> EVENT_EDEN_START_RECEIVE
    EdenEndReceive {} -> EVENT_EDEN_END_RECEIVE
    CreateProcess {} -> EVENT_CREATE_PROCESS
    KillProcess {} -> EVENT_KILL_PROCESS
    AssignThreadToProcess {} -> EVENT_ASSIGN_THREAD_TO_PROCESS
    CreateMachine {} -> EVENT_CREATE_MACHINE
    KillMachine {} -> EVENT_KILL_MACHINE
    SendMessage {} -> EVENT_SEND_MESSAGE
    ReceiveMessage {} -> EVENT_RECEIVE_MESSAGE
    SendReceiveLocalMessage {} -> EVENT_SEND_RECEIVE_LOCAL_MESSAGE
    MerStartParConjunction {} -> EVENT_MER_START_PAR_CONJUNCTION
    MerEndParConjunction Timestamp
_ -> EVENT_MER_STOP_PAR_CONJUNCTION
    MerEndParConjunct Timestamp
_ -> EVENT_MER_STOP_PAR_CONJUNCT
    MerCreateSpark {} -> EVENT_MER_CREATE_SPARK
    MerFutureCreate {} -> EVENT_MER_FUT_CREATE
    MerFutureWaitNosuspend Timestamp
_ -> EVENT_MER_FUT_WAIT_NOSUSPEND
    MerFutureWaitSuspended Timestamp
_ -> EVENT_MER_FUT_WAIT_SUSPENDED
    MerFutureSignal Timestamp
_ -> EVENT_MER_FUT_SIGNAL
    EventInfo
MerLookingForGlobalThread -> EVENT_MER_LOOKING_FOR_GLOBAL_CONTEXT
    EventInfo
MerWorkStealing -> EVENT_MER_WORK_STEALING
    EventInfo
MerLookingForLocalSpark -> EVENT_MER_LOOKING_FOR_LOCAL_SPARK
    MerReleaseThread EventTypeDescLen
_ -> EVENT_MER_RELEASE_CONTEXT
    EventInfo
MerCapSleeping -> EVENT_MER_ENGINE_SLEEPING
    EventInfo
MerCallingMain -> EVENT_MER_CALLING_MAIN
    PerfName       {} -> EventTypeNum
nEVENT_PERF_NAME
    PerfCounter    {} -> EventTypeNum
nEVENT_PERF_COUNTER
    PerfTracepoint {} -> EventTypeNum
nEVENT_PERF_TRACEPOINT
    HeapProfBegin {} -> EVENT_HEAP_PROF_BEGIN
    HeapProfCostCentre {} -> EVENT_HEAP_PROF_COST_CENTRE
    HeapProfSampleBegin {} -> EVENT_HEAP_PROF_SAMPLE_BEGIN
    HeapProfSampleEnd {} -> EVENT_HEAP_PROF_SAMPLE_END
    HeapBioProfSampleBegin {} -> EVENT_HEAP_BIO_PROF_SAMPLE_BEGIN
    HeapProfSampleCostCentre {} -> EVENT_HEAP_PROF_SAMPLE_COST_CENTRE
    HeapProfSampleString {} -> EVENT_HEAP_PROF_SAMPLE_STRING
    ProfSampleCostCentre {} -> EVENT_PROF_SAMPLE_COST_CENTRE
    ProfBegin {}            -> EVENT_PROF_BEGIN
    UserBinaryMessage {} -> EVENT_USER_BINARY_MSG
    ConcMarkBegin {} -> EVENT_CONC_MARK_BEGIN
    ConcMarkEnd {} -> EVENT_CONC_MARK_END
    ConcSyncBegin {} -> EVENT_CONC_SYNC_BEGIN
    ConcSyncEnd {} -> EVENT_CONC_SYNC_END
    ConcSweepBegin {} -> EVENT_CONC_SWEEP_BEGIN
    ConcSweepEnd {} -> EVENT_CONC_SWEEP_END
    ConcUpdRemSetFlush {} -> EVENT_CONC_UPD_REM_SET_FLUSH
    NonmovingHeapCensus {} -> EVENT_NONMOVING_HEAP_CENSUS

nEVENT_PERF_NAME, nEVENT_PERF_COUNTER, nEVENT_PERF_TRACEPOINT :: EventTypeNum
nEVENT_PERF_NAME :: EventTypeNum
nEVENT_PERF_NAME = EVENT_PERF_NAME
nEVENT_PERF_COUNTER :: EventTypeNum
nEVENT_PERF_COUNTER = EVENT_PERF_COUNTER
nEVENT_PERF_TRACEPOINT :: EventTypeNum
nEVENT_PERF_TRACEPOINT = EVENT_PERF_TRACEPOINT

putEvent :: Event -> PutM ()
putEvent :: Event -> PutM ()
putEvent Event {Maybe Int
Timestamp
EventInfo
evCap :: Maybe Int
evSpec :: EventInfo
evTime :: Timestamp
evSpec :: Event -> EventInfo
evTime :: Event -> Timestamp
evCap :: Event -> Maybe Int
..} = do
    EventTypeNum -> PutM ()
putType (EventInfo -> EventTypeNum
eventTypeNum EventInfo
evSpec)
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
put Timestamp
evTime
    EventInfo -> PutM ()
putEventSpec EventInfo
evSpec

putEventSpec :: EventInfo -> PutM ()
putEventSpec :: EventInfo -> PutM ()
putEventSpec (Startup Int
caps) = do
    Int -> PutM ()
putCap (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
caps)

putEventSpec (EventBlock Timestamp
end Int
cap EventTypeDescLen
sz) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE (EventTypeDescLen -> EventTypeDescLen
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EventTypeDescLen
szEventTypeDescLen -> EventTypeDescLen -> EventTypeDescLen
forall a. Num a => a -> a -> a
+EventTypeDescLen
24) :: BlockSize)
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
end
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cap :: CapNo)

putEventSpec (CreateThread EventTypeDescLen
t) =
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t

putEventSpec (RunThread EventTypeDescLen
t) =
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t

-- here we assume that ThreadStopStatus fromEnum matches the definitions in
-- EventLogFormat.h
-- The standard encoding is used here, which is wrong for eventlogs
-- produced by GHC-7.8.2 ([Stop status in GHC-7.8.2] in EventTypes.hs
putEventSpec (StopThread EventTypeDescLen
t ThreadStopStatus
s) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (EventTypeNum -> PutM ()) -> EventTypeNum -> PutM ()
forall a b. (a -> b) -> a -> b
$ case ThreadStopStatus
s of
            ThreadStopStatus
NoStatus -> EventTypeNum
0 :: Word16
            ThreadStopStatus
HeapOverflow -> EventTypeNum
1
            ThreadStopStatus
StackOverflow -> EventTypeNum
2
            ThreadStopStatus
ThreadYielding -> EventTypeNum
3
            ThreadStopStatus
ThreadBlocked -> EventTypeNum
4
            ThreadStopStatus
ThreadFinished -> EventTypeNum
5
            ThreadStopStatus
ForeignCall -> EventTypeNum
6
            ThreadStopStatus
BlockedOnMVar -> EventTypeNum
7
            ThreadStopStatus
BlockedOnMVarRead -> EventTypeNum
20 -- since GHC-7.8.3
            ThreadStopStatus
BlockedOnBlackHole -> EventTypeNum
8
            BlockedOnBlackHoleOwnedBy EventTypeDescLen
_ -> EventTypeNum
8
            ThreadStopStatus
BlockedOnRead -> EventTypeNum
9
            ThreadStopStatus
BlockedOnWrite -> EventTypeNum
10
            ThreadStopStatus
BlockedOnDelay -> EventTypeNum
11
            ThreadStopStatus
BlockedOnSTM -> EventTypeNum
12
            ThreadStopStatus
BlockedOnDoProc -> EventTypeNum
13
            ThreadStopStatus
BlockedOnCCall -> EventTypeNum
14
            ThreadStopStatus
BlockedOnCCall_NoUnblockExc -> EventTypeNum
15
            ThreadStopStatus
BlockedOnMsgThrowTo -> EventTypeNum
16
            ThreadStopStatus
ThreadMigrating -> EventTypeNum
17
            ThreadStopStatus
BlockedOnMsgGlobalise -> EventTypeNum
18
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE (EventTypeDescLen -> PutM ()) -> EventTypeDescLen -> PutM ()
forall a b. (a -> b) -> a -> b
$ case ThreadStopStatus
s of
            BlockedOnBlackHoleOwnedBy EventTypeDescLen
i -> EventTypeDescLen
i
            ThreadStopStatus
_                           -> EventTypeDescLen
0

putEventSpec (ThreadRunnable EventTypeDescLen
t) =
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t

putEventSpec (MigrateThread EventTypeDescLen
t Int
c) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t
    Int -> PutM ()
putCap Int
c

putEventSpec (CreateSparkThread EventTypeDescLen
t) =
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t

putEventSpec (SparkCounters Timestamp
crt Timestamp
dud Timestamp
ovf Timestamp
cnv Timestamp
fiz Timestamp
gcd Timestamp
rem) = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
crt
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
dud
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
ovf
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
cnv
    -- Warning: order of fiz and gcd reversed!
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
gcd
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
fiz
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
rem

putEventSpec EventInfo
SparkCreate =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
SparkDud =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
SparkOverflow =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
SparkRun =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec (SparkSteal Int
c) =
    Int -> PutM ()
putCap Int
c

putEventSpec EventInfo
SparkFizzle =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
SparkGC =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec (WakeupThread EventTypeDescLen
t Int
c) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t
    Int -> PutM ()
putCap Int
c

putEventSpec (ThreadLabel EventTypeDescLen
t (Text -> ByteString
TE.encodeUtf8 -> ByteString
l)) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
l) EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_tid :: Word16)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
t
    ByteString -> PutM ()
putByteString ByteString
l

putEventSpec EventInfo
Shutdown =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
RequestSeqGC =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
RequestParGC =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
StartGC =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
GCWork =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
GCIdle =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
GCDone =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
EndGC =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec EventInfo
GlobalSyncGC =
    () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec (TaskCreate Timestamp
taskId Int
cap KernelThreadId
tid) = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
taskId
    Int -> PutM ()
putCap Int
cap
    KernelThreadId -> PutM ()
forall t. Binary t => t -> PutM ()
putE KernelThreadId
tid

putEventSpec (TaskMigrate Timestamp
taskId Int
cap Int
new_cap) = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
taskId
    Int -> PutM ()
putCap Int
cap
    Int -> PutM ()
putCap Int
new_cap

putEventSpec (TaskDelete Timestamp
taskId) =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
taskId

putEventSpec GCStatsGHC{Int
Maybe Timestamp
EventTypeDescLen
Timestamp
parBalancedCopied :: Maybe Timestamp
parTotCopied :: Timestamp
parMaxCopied :: Timestamp
parNThreads :: Int
frag :: Timestamp
slop :: Timestamp
copied :: Timestamp
gen :: Int
heapCapset :: EventTypeDescLen
parTotCopied :: EventInfo -> Timestamp
parMaxCopied :: EventInfo -> Timestamp
frag :: EventInfo -> Timestamp
slop :: EventInfo -> Timestamp
copied :: EventInfo -> Timestamp
heapCapset :: EventInfo -> EventTypeDescLen
parBalancedCopied :: EventInfo -> Maybe Timestamp
parNThreads :: EventInfo -> Int
gen :: EventInfo -> Int
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
heapCapset
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gen :: Word16)
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
copied
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
slop
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
frag
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeDescLen
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
parNThreads :: Word32)
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
parMaxCopied
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
parTotCopied
    case Maybe Timestamp
parBalancedCopied of
      Maybe Timestamp
Nothing -> () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Timestamp
v  -> Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
v

putEventSpec HeapAllocated{EventTypeDescLen
Timestamp
allocBytes :: Timestamp
heapCapset :: EventTypeDescLen
allocBytes :: EventInfo -> Timestamp
heapCapset :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
heapCapset
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
allocBytes

putEventSpec HeapSize{EventTypeDescLen
Timestamp
sizeBytes :: Timestamp
heapCapset :: EventTypeDescLen
sizeBytes :: EventInfo -> Timestamp
heapCapset :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
heapCapset
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
sizeBytes

putEventSpec HeapLive{EventTypeDescLen
Timestamp
liveBytes :: Timestamp
heapCapset :: EventTypeDescLen
liveBytes :: EventInfo -> Timestamp
heapCapset :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
heapCapset
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
liveBytes

putEventSpec HeapInfoGHC{Int
EventTypeDescLen
Timestamp
blockSize :: Timestamp
mblockSize :: Timestamp
allocAreaSize :: Timestamp
maxHeapSize :: Timestamp
gens :: Int
heapCapset :: EventTypeDescLen
blockSize :: EventInfo -> Timestamp
mblockSize :: EventInfo -> Timestamp
allocAreaSize :: EventInfo -> Timestamp
maxHeapSize :: EventInfo -> Timestamp
gens :: EventInfo -> Int
heapCapset :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
heapCapset
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gens :: Word16)
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
maxHeapSize
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
allocAreaSize
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
mblockSize
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
blockSize

putEventSpec CapCreate{Int
cap :: Int
cap :: EventInfo -> Int
cap} =
    Int -> PutM ()
putCap Int
cap

putEventSpec CapDelete{Int
cap :: Int
cap :: EventInfo -> Int
cap} =
    Int -> PutM ()
putCap Int
cap

putEventSpec CapDisable{Int
cap :: Int
cap :: EventInfo -> Int
cap} =
    Int -> PutM ()
putCap Int
cap

putEventSpec CapEnable{Int
cap :: Int
cap :: EventInfo -> Int
cap} =
    Int -> PutM ()
putCap Int
cap

putEventSpec (CapsetCreate EventTypeDescLen
cs CapsetType
ct) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (EventTypeNum -> PutM ()) -> EventTypeNum -> PutM ()
forall a b. (a -> b) -> a -> b
$ case CapsetType
ct of
            CapsetType
CapsetCustom -> EventTypeNum
1 :: Word16
            CapsetType
CapsetOsProcess -> EventTypeNum
2
            CapsetType
CapsetClockDomain -> EventTypeNum
3
            CapsetType
CapsetUnknown -> EventTypeNum
0

putEventSpec (CapsetDelete EventTypeDescLen
cs) =
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs

putEventSpec (CapsetAssignCap EventTypeDescLen
cs Int
cp) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    Int -> PutM ()
putCap Int
cp

putEventSpec (CapsetRemoveCap EventTypeDescLen
cs Int
cp) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    Int -> PutM ()
putCap Int
cp

putEventSpec (RtsIdentifier EventTypeDescLen
cs (Text -> ByteString
TE.encodeUtf8 -> ByteString
rts)) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
rts) EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_capset :: Word16)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    ByteString -> PutM ()
putByteString ByteString
rts

putEventSpec (ProgramArgs EventTypeDescLen
cs ((Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
TE.encodeUtf8 -> [ByteString]
as)) = do
    let sz_args :: Int
sz_args = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) {- for \0 -} (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
as) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz_args EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_capset :: Word16)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    (ByteString -> PutM ()) -> [ByteString] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> PutM ()
putByteString (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse ByteString
"\0" [ByteString]
as)

putEventSpec (ProgramEnv EventTypeDescLen
cs ((Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
TE.encodeUtf8 -> [ByteString]
es)) = do
    let sz_env :: Int
sz_env = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) {- for \0 -} (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
es) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz_env EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_capset :: Word16)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    (ByteString -> PutM ()) -> [ByteString] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> PutM ()
putByteString ([ByteString] -> PutM ()) -> [ByteString] -> PutM ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse ByteString
"\0" [ByteString]
es

putEventSpec (OsProcessPid EventTypeDescLen
cs EventTypeDescLen
pid) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
pid

putEventSpec (OsProcessParentPid EventTypeDescLen
cs EventTypeDescLen
ppid) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
ppid

putEventSpec (WallClockTime EventTypeDescLen
cs Timestamp
sec EventTypeDescLen
nsec) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
cs
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
sec
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
nsec

putEventSpec (Message (Text -> ByteString
TE.encodeUtf8 -> ByteString
s)) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
s) :: Word16)
    ByteString -> PutM ()
putByteString ByteString
s

putEventSpec (UserMessage (Text -> ByteString
TE.encodeUtf8 -> ByteString
s)) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
s) :: Word16)
    ByteString -> PutM ()
putByteString ByteString
s

putEventSpec (UserMarker (Text -> ByteString
TE.encodeUtf8 -> ByteString
s)) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
s) :: Word16)
    ByteString -> PutM ()
putByteString ByteString
s

putEventSpec (UnknownEvent {}) = String -> PutM ()
forall a. HasCallStack => String -> a
error String
"putEventSpec UnknownEvent"

putEventSpec (InternString String
str EventTypeDescLen
id) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeNum
len
    (Char -> PutM ()) -> String -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> PutM ()
forall t. Binary t => t -> PutM ()
putE String
str
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
id
  where len :: EventTypeNum
len = (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) :: Word16) EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_string_id

putEventSpec (Version String
s) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) :: Word16)
    (Char -> PutM ()) -> String -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> PutM ()
forall t. Binary t => t -> PutM ()
putE String
s

putEventSpec (ProgramInvocation String
s) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) :: Word16)
    (Char -> PutM ()) -> String -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> PutM ()
forall t. Binary t => t -> PutM ()
putE String
s

putEventSpec ( EventInfo
EdenStartReceive ) = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec ( EventInfo
EdenEndReceive ) = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec ( CreateProcess  EventTypeDescLen
process ) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
process

putEventSpec ( KillProcess EventTypeDescLen
process ) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
process

putEventSpec ( AssignThreadToProcess EventTypeDescLen
thread EventTypeDescLen
process ) = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
thread
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
process

putEventSpec ( CreateMachine EventTypeNum
machine Timestamp
realtime ) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeNum
machine
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
realtime

putEventSpec ( KillMachine EventTypeNum
machine ) = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeNum
machine

putEventSpec ( SendMessage MessageTag
mesTag EventTypeDescLen
senderProcess EventTypeDescLen
senderThread
                 EventTypeNum
receiverMachine EventTypeDescLen
receiverProcess EventTypeDescLen
receiverInport ) = do
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE (MessageTag -> Word8
fromMsgTag MessageTag
mesTag)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
senderProcess
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
senderThread
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeNum
receiverMachine
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
receiverProcess
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
receiverInport

putEventSpec ( ReceiveMessage MessageTag
mesTag EventTypeDescLen
receiverProcess EventTypeDescLen
receiverInport
                 EventTypeNum
senderMachine EventTypeDescLen
senderProcess EventTypeDescLen
senderThread EventTypeDescLen
messageSize ) = do
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE (MessageTag -> Word8
fromMsgTag MessageTag
mesTag)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
receiverProcess
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
receiverInport
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeNum
senderMachine
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
senderProcess
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
senderThread
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
messageSize

putEventSpec ( SendReceiveLocalMessage MessageTag
mesTag EventTypeDescLen
senderProcess EventTypeDescLen
senderThread
                 EventTypeDescLen
receiverProcess EventTypeDescLen
receiverInport ) = do
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE (MessageTag -> Word8
fromMsgTag MessageTag
mesTag)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
senderProcess
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
senderThread
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
receiverProcess
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
receiverInport

putEventSpec (MerStartParConjunction Timestamp
dyn_id EventTypeDescLen
static_id) = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
dyn_id
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
static_id

putEventSpec (MerEndParConjunction Timestamp
dyn_id) =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
dyn_id

putEventSpec (MerEndParConjunct Timestamp
dyn_id) =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
dyn_id

putEventSpec (MerCreateSpark Timestamp
dyn_id EventTypeDescLen
spark_id) = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
dyn_id
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
spark_id

putEventSpec (MerFutureCreate Timestamp
future_id EventTypeDescLen
name_id) = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
future_id
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
name_id

putEventSpec (MerFutureWaitNosuspend Timestamp
future_id) =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
future_id

putEventSpec (MerFutureWaitSuspended Timestamp
future_id) =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
future_id

putEventSpec (MerFutureSignal Timestamp
future_id) =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
future_id

putEventSpec EventInfo
MerLookingForGlobalThread = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec EventInfo
MerWorkStealing = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec EventInfo
MerLookingForLocalSpark = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec (MerReleaseThread EventTypeDescLen
thread_id) =
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
thread_id

putEventSpec EventInfo
MerCapSleeping = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec EventInfo
MerCallingMain = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putEventSpec PerfName{name :: EventInfo -> Text
name = (Text -> ByteString
TE.encodeUtf8 -> ByteString
name), EventTypeDescLen
perfNum :: EventTypeDescLen
perfNum :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
name) EventTypeNum -> EventTypeNum -> EventTypeNum
forall a. Num a => a -> a -> a
+ EventTypeNum
sz_perf_num :: Word16)
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
perfNum
    ByteString -> PutM ()
putByteString ByteString
name

putEventSpec PerfCounter{EventTypeDescLen
Timestamp
KernelThreadId
period :: Timestamp
tid :: KernelThreadId
perfNum :: EventTypeDescLen
period :: EventInfo -> Timestamp
perfNum :: EventInfo -> EventTypeDescLen
tid :: EventInfo -> KernelThreadId
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
perfNum
    KernelThreadId -> PutM ()
forall t. Binary t => t -> PutM ()
putE KernelThreadId
tid
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
period

putEventSpec PerfTracepoint{EventTypeDescLen
KernelThreadId
tid :: KernelThreadId
perfNum :: EventTypeDescLen
perfNum :: EventInfo -> EventTypeDescLen
tid :: EventInfo -> KernelThreadId
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
perfNum
    KernelThreadId -> PutM ()
forall t. Binary t => t -> PutM ()
putE KernelThreadId
tid

putEventSpec HeapProfBegin {Word8
Timestamp
Text
HeapProfBreakdown
heapProfBiographyFilter :: Text
heapProfRetainerFilter :: Text
heapProfCostCentreStackFilter :: Text
heapProfCostCentreFilter :: Text
heapProfTypeDescrFilter :: Text
heapProfClosureDescrFilter :: Text
heapProfModuleFilter :: Text
heapProfBreakdown :: HeapProfBreakdown
heapProfSamplingPeriod :: Timestamp
heapProfId :: Word8
heapProfBiographyFilter :: EventInfo -> Text
heapProfRetainerFilter :: EventInfo -> Text
heapProfCostCentreStackFilter :: EventInfo -> Text
heapProfCostCentreFilter :: EventInfo -> Text
heapProfTypeDescrFilter :: EventInfo -> Text
heapProfClosureDescrFilter :: EventInfo -> Text
heapProfModuleFilter :: EventInfo -> Text
heapProfBreakdown :: EventInfo -> HeapProfBreakdown
heapProfSamplingPeriod :: EventInfo -> Timestamp
heapProfId :: EventInfo -> Word8
..} = do
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE Word8
heapProfId
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
heapProfSamplingPeriod
    HeapProfBreakdown -> PutM ()
forall t. Binary t => t -> PutM ()
putE HeapProfBreakdown
heapProfBreakdown
    (Text -> PutM ()) -> [Text] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> PutM ()
forall t. Binary t => t -> PutM ()
putE (String -> PutM ()) -> (Text -> String) -> Text -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
      [ Text
heapProfModuleFilter
      , Text
heapProfClosureDescrFilter
      , Text
heapProfTypeDescrFilter
      , Text
heapProfCostCentreFilter
      , Text
heapProfCostCentreStackFilter
      , Text
heapProfRetainerFilter
      , Text
heapProfBiographyFilter
      ]

putEventSpec HeapProfCostCentre {EventTypeDescLen
Text
HeapProfFlags
heapProfFlags :: HeapProfFlags
heapProfSrcLoc :: Text
heapProfModule :: Text
heapProfLabel :: Text
heapProfCostCentreId :: EventTypeDescLen
heapProfFlags :: EventInfo -> HeapProfFlags
heapProfSrcLoc :: EventInfo -> Text
heapProfModule :: EventInfo -> Text
heapProfLabel :: EventInfo -> Text
heapProfCostCentreId :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
heapProfCostCentreId
    String -> PutM ()
forall t. Binary t => t -> PutM ()
putE (String -> PutM ()) -> String -> PutM ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
heapProfLabel
    String -> PutM ()
forall t. Binary t => t -> PutM ()
putE (String -> PutM ()) -> String -> PutM ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
heapProfModule
    String -> PutM ()
forall t. Binary t => t -> PutM ()
putE (String -> PutM ()) -> String -> PutM ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
heapProfSrcLoc
    HeapProfFlags -> PutM ()
forall t. Binary t => t -> PutM ()
putE HeapProfFlags
heapProfFlags

putEventSpec HeapProfSampleBegin {Timestamp
heapProfSampleEra :: Timestamp
heapProfSampleEra :: EventInfo -> Timestamp
..} =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
heapProfSampleEra

putEventSpec HeapProfSampleEnd {Timestamp
heapProfSampleEra :: Timestamp
heapProfSampleEra :: EventInfo -> Timestamp
..} =
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
heapProfSampleEra

putEventSpec HeapBioProfSampleBegin {Timestamp
heapProfSampleTime :: Timestamp
heapProfSampleEra :: Timestamp
heapProfSampleTime :: EventInfo -> Timestamp
heapProfSampleEra :: EventInfo -> Timestamp
..} = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
heapProfSampleEra
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
heapProfSampleTime


putEventSpec HeapProfSampleCostCentre {Word8
Timestamp
Vector EventTypeDescLen
heapProfStack :: Vector EventTypeDescLen
heapProfStackDepth :: Word8
heapProfResidency :: Timestamp
heapProfId :: Word8
heapProfStack :: EventInfo -> Vector EventTypeDescLen
heapProfStackDepth :: EventInfo -> Word8
heapProfResidency :: EventInfo -> Timestamp
heapProfId :: EventInfo -> Word8
..} = do
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE Word8
heapProfId
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
heapProfResidency
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE Word8
heapProfStackDepth
    (EventTypeDescLen -> PutM ()) -> Vector EventTypeDescLen -> PutM ()
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
(a -> m b) -> Vector a -> m ()
VU.mapM_ EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE Vector EventTypeDescLen
heapProfStack

putEventSpec HeapProfSampleString {Word8
Timestamp
Text
heapProfLabel :: Text
heapProfResidency :: Timestamp
heapProfId :: Word8
heapProfResidency :: EventInfo -> Timestamp
heapProfLabel :: EventInfo -> Text
heapProfId :: EventInfo -> Word8
..} = do
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE Word8
heapProfId
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
heapProfResidency
    String -> PutM ()
forall t. Binary t => t -> PutM ()
putE (String -> PutM ()) -> String -> PutM ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
heapProfLabel

putEventSpec ProfSampleCostCentre {Word8
EventTypeDescLen
Timestamp
Vector EventTypeDescLen
profCcsStack :: Vector EventTypeDescLen
profStackDepth :: Word8
profTicks :: Timestamp
profCapset :: EventTypeDescLen
profCcsStack :: EventInfo -> Vector EventTypeDescLen
profStackDepth :: EventInfo -> Word8
profTicks :: EventInfo -> Timestamp
profCapset :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
profCapset
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
profTicks
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE Word8
profStackDepth
    (EventTypeDescLen -> PutM ()) -> Vector EventTypeDescLen -> PutM ()
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
(a -> m b) -> Vector a -> m ()
VU.mapM_ EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE Vector EventTypeDescLen
profCcsStack

putEventSpec ProfBegin {Timestamp
profTickInterval :: Timestamp
profTickInterval :: EventInfo -> Timestamp
..} = do
    Timestamp -> PutM ()
forall t. Binary t => t -> PutM ()
putE Timestamp
profTickInterval

putEventSpec UserBinaryMessage {ByteString
payload :: ByteString
payload :: EventInfo -> ByteString
..} = do
    EventTypeNum -> PutM ()
forall t. Binary t => t -> PutM ()
putE (Int -> EventTypeNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
payload) :: Word16)
    ByteString -> PutM ()
putByteString ByteString
payload

putEventSpec EventInfo
ConcMarkBegin = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec ConcMarkEnd {EventTypeDescLen
concMarkedObjectCount :: EventTypeDescLen
concMarkedObjectCount :: EventInfo -> EventTypeDescLen
..} = do
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
concMarkedObjectCount
putEventSpec EventInfo
ConcSyncBegin = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec EventInfo
ConcSyncEnd = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec EventInfo
ConcSweepBegin = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec EventInfo
ConcSweepEnd = () -> PutM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putEventSpec ConcUpdRemSetFlush {Int
cap :: Int
cap :: EventInfo -> Int
..} = do
    Int -> PutM ()
putCap Int
cap
putEventSpec NonmovingHeapCensus {Word8
EventTypeDescLen
nonmovingCensusLiveBlocks :: EventTypeDescLen
nonmovingCensusFilledSegs :: EventTypeDescLen
nonmovingCensusActiveSegs :: EventTypeDescLen
nonmovingCensusBlkSize :: Word8
nonmovingCensusLiveBlocks :: EventInfo -> EventTypeDescLen
nonmovingCensusFilledSegs :: EventInfo -> EventTypeDescLen
nonmovingCensusActiveSegs :: EventInfo -> EventTypeDescLen
nonmovingCensusBlkSize :: EventInfo -> Word8
..} = do
    Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
putE Word8
nonmovingCensusBlkSize
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
nonmovingCensusActiveSegs
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
nonmovingCensusFilledSegs
    EventTypeDescLen -> PutM ()
forall t. Binary t => t -> PutM ()
putE EventTypeDescLen
nonmovingCensusLiveBlocks