{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

{- |
Module      : GHC.Eventlog.Live.Machine.Analysis.Thread
Description : Machines for processing eventlog data.
Stability   : experimental
Portability : portable
-}
module GHC.Eventlog.Live.Machine.Analysis.Thread (
  -- * Thread Analysis

  -- ** Thread Labels
  ThreadLabel (..),
  processThreadLabels,

  -- ** Thread State Spans
  ThreadState (..),
  showThreadStateCategory,
  threadStateStatus,
  threadStateCap,
  ThreadStateSpan (..),
  processThreadStateSpans,
  processThreadStateSpans',
) where

import Control.Monad.IO.Class (MonadIO (..))
import Data.Char (isSpace)
import Data.Machine (Is (..), PlanT, Process, ProcessT, await, construct, repeatedly, yield)
import Data.Maybe (isNothing)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import GHC.Eventlog.Live.Data.Span (duration)
import GHC.Eventlog.Live.Logger (logWarning)
import GHC.Eventlog.Live.Machine.Core (liftRouter)
import GHC.Eventlog.Live.Machine.WithStartTime (WithStartTime (..), tryGetTimeUnixNano)
import GHC.Eventlog.Live.Verbosity (Verbosity)
import GHC.RTS.Events (Event (..), EventInfo, ThreadId, ThreadStopStatus (..), Timestamp)
import GHC.RTS.Events qualified as E
import Text.Printf (printf)

-------------------------------------------------------------------------------
-- Thread Labels

{- |
The t`ThreadLabel` type represents the association of a label with a thread
starting at a given time.
-}
data ThreadLabel
  = ThreadLabel
  { ThreadLabel -> ThreadId
thread :: !ThreadId
  , ThreadLabel -> Text
threadlabel :: !Text
  , ThreadLabel -> Timestamp
startTimeUnixNano :: !Timestamp
  }

{- |
This machine processes `E.ThreadLabel` events and yields t`ThreadLabel` values.
-}
processThreadLabels :: Process (WithStartTime Event) ThreadLabel
processThreadLabels :: Process (WithStartTime Event) ThreadLabel
processThreadLabels = PlanT (Is (WithStartTime Event)) ThreadLabel m ()
-> MachineT m (Is (WithStartTime Event)) ThreadLabel
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly PlanT (Is (WithStartTime Event)) ThreadLabel m ()
forall {m :: * -> *}.
PlanT (Is (WithStartTime Event)) ThreadLabel m ()
go
 where
  go :: PlanT (Is (WithStartTime Event)) ThreadLabel m ()
go =
    PlanT
  (Is (WithStartTime Event)) ThreadLabel m (WithStartTime Event)
Plan (Is (WithStartTime Event)) ThreadLabel (WithStartTime Event)
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT
  (Is (WithStartTime Event)) ThreadLabel m (WithStartTime Event)
-> (WithStartTime Event
    -> PlanT (Is (WithStartTime Event)) ThreadLabel m ())
-> PlanT (Is (WithStartTime Event)) ThreadLabel m ()
forall a b.
PlanT (Is (WithStartTime Event)) ThreadLabel m a
-> (a -> PlanT (Is (WithStartTime Event)) ThreadLabel m b)
-> PlanT (Is (WithStartTime Event)) ThreadLabel m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WithStartTime Event
i -> case WithStartTime Event
i.value.evSpec of
      E.ThreadLabel{ThreadId
Text
thread :: ThreadId
threadlabel :: Text
thread :: EventInfo -> ThreadId
threadlabel :: EventInfo -> Text
..}
        | Just Timestamp
startTimeUnixNano <- WithStartTime Event -> Maybe Timestamp
tryGetTimeUnixNano WithStartTime Event
i ->
            ThreadLabel
-> forall {m :: * -> *}.
   PlanT (Is (WithStartTime Event)) ThreadLabel m ()
forall o (k :: * -> *). o -> Plan k o ()
yield ThreadLabel{ThreadId
Timestamp
Text
thread :: ThreadId
threadlabel :: Text
startTimeUnixNano :: Timestamp
thread :: ThreadId
threadlabel :: Text
startTimeUnixNano :: Timestamp
..}
      EventInfo
_otherwise -> () -> PlanT (Is (WithStartTime Event)) ThreadLabel m ()
forall a. a -> PlanT (Is (WithStartTime Event)) ThreadLabel m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-------------------------------------------------------------------------------
-- Thread State Spans

{- |
The execution states of a mutator thread.
-}
data ThreadState
  = Running {ThreadState -> Int
cap :: !Int}
  | Blocked {ThreadState -> ThreadStopStatus
status :: !ThreadStopStatus}
  | Finished
  deriving (Int -> ThreadState -> String -> String
[ThreadState] -> String -> String
ThreadState -> String
(Int -> ThreadState -> String -> String)
-> (ThreadState -> String)
-> ([ThreadState] -> String -> String)
-> Show ThreadState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ThreadState -> String -> String
showsPrec :: Int -> ThreadState -> String -> String
$cshow :: ThreadState -> String
show :: ThreadState -> String
$cshowList :: [ThreadState] -> String -> String
showList :: [ThreadState] -> String -> String
Show)

{- |
Pretty-print a thread state as "Running", "Blocked", or "Finished".
-}
showThreadStateCategory :: ThreadState -> Text
showThreadStateCategory :: ThreadState -> Text
showThreadStateCategory = \case
  Running{} -> Text
"Running"
  Blocked{} -> Text
"Blocked"
  Finished{} -> Text
"Finished"

{- |
Get the t`ThreadState` status, if the t`ThreadState` is `Blocked`.
-}
threadStateStatus :: ThreadState -> Maybe ThreadStopStatus
threadStateStatus :: ThreadState -> Maybe ThreadStopStatus
threadStateStatus = \case
  Running{} -> Maybe ThreadStopStatus
forall a. Maybe a
Nothing
  Blocked{ThreadStopStatus
status :: ThreadState -> ThreadStopStatus
status :: ThreadStopStatus
status} -> ThreadStopStatus -> Maybe ThreadStopStatus
forall a. a -> Maybe a
Just ThreadStopStatus
status
  Finished{} -> Maybe ThreadStopStatus
forall a. Maybe a
Nothing

{- |
Get the t`ThreadState` capability, if the `ThreadState` is `Running`.
-}
threadStateCap :: ThreadState -> Maybe Int
threadStateCap :: ThreadState -> Maybe Int
threadStateCap = \case
  Running{Int
cap :: ThreadState -> Int
cap :: Int
cap} -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
cap
  Blocked{} -> Maybe Int
forall a. Maybe a
Nothing
  Finished{} -> Maybe Int
forall a. Maybe a
Nothing

{- |
A span representing the state of a mutator thread.
-}
data ThreadStateSpan
  = ThreadStateSpan
  { ThreadStateSpan -> ThreadId
thread :: !ThreadId
  , ThreadStateSpan -> ThreadState
threadState :: !ThreadState
  , ThreadStateSpan -> Timestamp
startTimeUnixNano :: !Timestamp
  , ThreadStateSpan -> Timestamp
endTimeUnixNano :: !Timestamp
  }
  deriving (Int -> ThreadStateSpan -> String -> String
[ThreadStateSpan] -> String -> String
ThreadStateSpan -> String
(Int -> ThreadStateSpan -> String -> String)
-> (ThreadStateSpan -> String)
-> ([ThreadStateSpan] -> String -> String)
-> Show ThreadStateSpan
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ThreadStateSpan -> String -> String
showsPrec :: Int -> ThreadStateSpan -> String -> String
$cshow :: ThreadStateSpan -> String
show :: ThreadStateSpan -> String
$cshowList :: [ThreadStateSpan] -> String -> String
showList :: [ThreadStateSpan] -> String -> String
Show)

{-# SPECIALIZE duration :: ThreadStateSpan -> Timestamp #-}

{- |
This machine processes `E.RunThread` and `E.StopThread` events to produce
t`ThreadStateSpan` values that represent segments of time where a thread is
running, blocked, or finished.

This processor uses the following finite-state automaton:

@
      ┌─(StopThread)─┐
      │              ↓
    ┌→[   Blocked    ]─┐
    │                  │
(StopThread)       (RunThread)
    │                  │
    └─[   Running    ]←┘
      ↑              │
      └─(RunThread)──┘
@

The transitions from @Blocked@ to @Blocked@, @Blocked@ to @Running@, and
@Running@ to @Running@ yield a t`ThreadStateSpan`. There are additional
transitions (not pictured) from either state to the final `Finished` state
with a `E.StopThread` event with the `ThreadFinished` status.
-}
processThreadStateSpans ::
  (MonadIO m) =>
  Verbosity ->
  ProcessT m (WithStartTime Event) ThreadStateSpan
processThreadStateSpans :: forall (m :: * -> *).
MonadIO m =>
Verbosity -> ProcessT m (WithStartTime Event) ThreadStateSpan
processThreadStateSpans =
  (WithStartTime Event -> Maybe Timestamp)
-> (WithStartTime Event -> Event)
-> (WithStartTime Event -> ThreadStateSpan -> ThreadStateSpan)
-> Verbosity
-> ProcessT m (WithStartTime Event) ThreadStateSpan
forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> ThreadStateSpan -> t)
-> Verbosity
-> ProcessT m s t
processThreadStateSpans' WithStartTime Event -> Maybe Timestamp
tryGetTimeUnixNano (.value) ((ThreadStateSpan -> ThreadStateSpan)
-> WithStartTime Event -> ThreadStateSpan -> ThreadStateSpan
forall a b. a -> b -> a
const ThreadStateSpan -> ThreadStateSpan
forall a. a -> a
id)

{- |
Generalised version of `processThreadStateSpans` that can be adapted to work
on arbitrary types using a getter and a lens.
-}
processThreadStateSpans' ::
  forall m s t.
  (MonadIO m) =>
  (s -> Maybe Timestamp) ->
  (s -> Event) ->
  (s -> ThreadStateSpan -> t) ->
  Verbosity ->
  ProcessT m s t
processThreadStateSpans' :: forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> ThreadStateSpan -> t)
-> Verbosity
-> ProcessT m s t
processThreadStateSpans' s -> Maybe Timestamp
timeUnixNano s -> Event
getEvent s -> ThreadStateSpan -> t
setThreadStateSpan Verbosity
verbosity =
  (s -> Maybe ThreadId)
-> (ThreadId -> ProcessT m s t) -> ProcessT m s t
forall (m :: * -> *) k a b.
(MonadIO m, Hashable k) =>
(a -> Maybe k) -> (k -> ProcessT m a b) -> ProcessT m a b
liftRouter s -> Maybe ThreadId
measure ThreadId -> ProcessT m s t
spawn
 where
  getEventTime :: s -> Timestamp
getEventTime = (.evTime) (Event -> Timestamp) -> (s -> Event) -> s -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Event
getEvent
  getEventInfo :: s -> EventInfo
getEventInfo = (.evSpec) (Event -> EventInfo) -> (s -> Event) -> s -> EventInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Event
getEvent
  getEventCap :: s -> Maybe Int
getEventCap = (.evCap) (Event -> Maybe Int) -> (s -> Event) -> s -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Event
getEvent

  measure :: s -> Maybe ThreadId
  measure :: s -> Maybe ThreadId
measure s
i = case s -> EventInfo
getEventInfo s
i of
    E.RunThread{ThreadId
thread :: EventInfo -> ThreadId
thread :: ThreadId
thread} -> ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
thread
    E.StopThread{ThreadId
thread :: EventInfo -> ThreadId
thread :: ThreadId
thread} -> ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
thread
    EventInfo
_otherwise -> Maybe ThreadId
forall a. Maybe a
Nothing

  spawn :: ThreadId -> ProcessT m s t
  spawn :: ThreadId -> ProcessT m s t
spawn ThreadId
thread = PlanT (Is s) t m Void -> ProcessT m s t
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (PlanT (Is s) t m Void -> ProcessT m s t)
-> PlanT (Is s) t m Void -> ProcessT m s t
forall a b. (a -> b) -> a -> b
$ Maybe s -> PlanT (Is s) t m Void
go Maybe s
forall a. Maybe a
Nothing
   where
    go :: Maybe s -> PlanT (Is s) t m Void
    go :: Maybe s -> PlanT (Is s) t m Void
go Maybe s
mi =
      PlanT (Is s) t m s
Plan (Is s) t s
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (Is s) t m s
-> (s -> PlanT (Is s) t m Void) -> PlanT (Is s) t m Void
forall a b.
PlanT (Is s) t m a
-> (a -> PlanT (Is s) t m b) -> PlanT (Is s) t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        s
j
          -- If the previous event was a `E.StopThread` event, and...
          | Just E.StopThread{ThreadStopStatus
status :: ThreadStopStatus
status :: EventInfo -> ThreadStopStatus
status} <- s -> EventInfo
getEventInfo (s -> EventInfo) -> Maybe s -> Maybe EventInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s
mi
          , --- ...it has the `ThreadFinished` status, then...
            ThreadStopStatus -> Bool
isThreadFinished ThreadStopStatus
status ->
              -- ...ignore the current event.
              Maybe s -> PlanT (Is s) t m Void
go Maybe s
mi
          --
          -- If the current event is a `E.RunThread` event, and...
          | E.RunThread{} <- s -> EventInfo
getEventInfo s
j
          , -- ...the previous event was a `E.StopThread` event, then...
            Just E.StopThread{ThreadStopStatus
status :: EventInfo -> ThreadStopStatus
status :: ThreadStopStatus
status} <- s -> EventInfo
getEventInfo (s -> EventInfo) -> Maybe s -> Maybe EventInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s
mi
          , -- ...gather the end time of the previous event, and...
            Just Timestamp
startTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano (s -> Maybe Timestamp) -> Maybe s -> Maybe Timestamp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe s
mi
          , -- ...gather the start time of the current event, and...
            Just Timestamp
endTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano s
j -> do
              -- ...yield a thread state span, and...
              t -> PlanT (Is s) t m ()
t -> Plan (Is s) t ()
forall o (k :: * -> *). o -> Plan k o ()
yield (t -> PlanT (Is s) t m ())
-> (ThreadStateSpan -> t) -> ThreadStateSpan -> PlanT (Is s) t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ThreadStateSpan -> t
setThreadStateSpan s
j (ThreadStateSpan -> PlanT (Is s) t m ())
-> ThreadStateSpan -> PlanT (Is s) t m ()
forall a b. (a -> b) -> a -> b
$
                ThreadStateSpan{threadState :: ThreadState
threadState = ThreadStopStatus -> ThreadState
Blocked ThreadStopStatus
status, ThreadId
Timestamp
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
..}
              Maybe s -> PlanT (Is s) t m Void
go (s -> Maybe s
forall a. a -> Maybe a
Just s
j)
          --
          -- If the current event is a `E.RunThread` event, and...
          | E.RunThread{} <- s -> EventInfo
getEventInfo s
j
          , -- ...the previous event was a `E.RunThread` event, then...
            Just E.RunThread{} <- s -> EventInfo
getEventInfo (s -> EventInfo) -> Maybe s -> Maybe EventInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s
mi -> do
              -- ...keep the oldest event.
              Maybe s -> PlanT (Is s) t m Void
go (s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ s -> (s -> s) -> Maybe s -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s
j ((s -> Timestamp) -> s -> s -> s
forall b a. Ord b => (a -> b) -> a -> a -> a
minBy s -> Timestamp
getEventTime s
j) Maybe s
mi)
          --
          -- If the current event is a `E.RunThread` event, and...
          | E.RunThread{} <- s -> EventInfo
getEventInfo s
j
          , -- ...there is no previous event, then...
            Maybe s -> Bool
forall a. Maybe a -> Bool
isNothing Maybe s
mi ->
              -- ...keep the current event.
              --
              -- The reason for the additional `isNothing` test is because,
              -- otherwise, this case might silently swallow any `E.StopThread`
              -- events for which `timeUnixNano` gives `Nothing`.
              -- By excluding these, they are forwarded to the catch-all case.
              Maybe s -> PlanT (Is s) t m Void
go (s -> Maybe s
forall a. a -> Maybe a
Just s
j)
          --
          -- If the current event is a `E.StopThread` event, and...
          | E.StopThread{} <- s -> EventInfo
getEventInfo s
j
          , -- ...the previous event was a `E.StopThread` event, then...
            Just E.StopThread{ThreadStopStatus
status :: EventInfo -> ThreadStopStatus
status :: ThreadStopStatus
status} <- s -> EventInfo
getEventInfo (s -> EventInfo) -> Maybe s -> Maybe EventInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s
mi
          , -- ...gather the end time of the previous event, and...
            Just Timestamp
startTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano (s -> Maybe Timestamp) -> Maybe s -> Maybe Timestamp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe s
mi
          , -- ...gather the start time of the current event, and...
            Just Timestamp
endTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano s
j -> do
              -- ...yield a thread state span, and...
              t -> PlanT (Is s) t m ()
t -> Plan (Is s) t ()
forall o (k :: * -> *). o -> Plan k o ()
yield (t -> PlanT (Is s) t m ())
-> (ThreadStateSpan -> t) -> ThreadStateSpan -> PlanT (Is s) t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ThreadStateSpan -> t
setThreadStateSpan s
j (ThreadStateSpan -> PlanT (Is s) t m ())
-> ThreadStateSpan -> PlanT (Is s) t m ()
forall a b. (a -> b) -> a -> b
$
                ThreadStateSpan{threadState :: ThreadState
threadState = ThreadStopStatus -> ThreadState
Blocked ThreadStopStatus
status, ThreadId
Timestamp
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
..}
              -- ...keep the current event.
              --
              -- This causes us to adopt every `E.StopThread` event, until
              -- we hit a `E.StopThread` event with the `ThreadFinished`, at
              -- which point the first clause will cause us to stick with it.
              Maybe s -> PlanT (Is s) t m Void
go (s -> Maybe s
forall a. a -> Maybe a
Just s
j)
          --
          -- If the current event is a `E.StopThread` event, and...
          | E.StopThread{} <- s -> EventInfo
getEventInfo s
j
          , -- ...the previous event was a `E.RunThread` event, then...
            Just E.RunThread{} <- s -> EventInfo
getEventInfo (s -> EventInfo) -> Maybe s -> Maybe EventInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s
mi
          , -- ...gather the capability of the `E.RunThread` event, and...
            Just Int
cap <- s -> Maybe Int
getEventCap (s -> Maybe Int) -> Maybe s -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe s
mi
          , -- ...gather the end time of the previous event, and...
            Just Timestamp
startTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano (s -> Maybe Timestamp) -> Maybe s -> Maybe Timestamp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe s
mi
          , -- ...gather the start time of the current event, and...
            Just Timestamp
endTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano s
j -> do
              -- ...yield a thread state span, and...
              t -> PlanT (Is s) t m ()
t -> Plan (Is s) t ()
forall o (k :: * -> *). o -> Plan k o ()
yield (t -> PlanT (Is s) t m ())
-> (ThreadStateSpan -> t) -> ThreadStateSpan -> PlanT (Is s) t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ThreadStateSpan -> t
setThreadStateSpan s
j (ThreadStateSpan -> PlanT (Is s) t m ())
-> ThreadStateSpan -> PlanT (Is s) t m ()
forall a b. (a -> b) -> a -> b
$
                ThreadStateSpan{threadState :: ThreadState
threadState = Int -> ThreadState
Running Int
cap, ThreadId
Timestamp
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
..}
              -- ...keep the current event.
              Maybe s -> PlanT (Is s) t m Void
go (s -> Maybe s
forall a. a -> Maybe a
Just s
j)
          --
          -- If the current event is any other event, then...
          | Bool
otherwise -> do
              -- ...emit an error, and...
              Verbosity -> Text -> PlanT (Is s) t m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Verbosity -> Text -> m ()
logWarning Verbosity
verbosity (Text -> PlanT (Is s) t m ())
-> (String -> Text) -> String -> PlanT (Is s) t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> PlanT (Is s) t m ()) -> String -> PlanT (Is s) t m ()
forall a b. (a -> b) -> a -> b
$
                String -> ThreadId -> String -> String
forall r. PrintfType r => String -> r
printf
                  String
"Thread %d: Unexpected event %s"
                  ThreadId
thread
                  (EventInfo -> String
showEventInfo (s -> EventInfo
getEventInfo s
j))
              --
              -- This case may trigger for any event that isn't `E.RunThread`
              -- or `E.StopThread` and for any `E.StopThread` event that comes
              -- before the first `E.RunThread` event. It may also trigger for
              -- any event for which `timeUnixNano` returns `Nothing`.
              --
              -- ...ignore it.
              Maybe s -> PlanT (Is s) t m Void
go Maybe s
mi

-------------------------------------------------------------------------------
-- Internal Helpers
-------------------------------------------------------------------------------

{- |
Internal helper.
Check whether a t`ThreadStopStatus` is equal to `ThreadFinished`.
This is needed because t`ThreadStopStatus` does not define an `Eq` instance.
-}
isThreadFinished :: ThreadStopStatus -> Bool
isThreadFinished :: ThreadStopStatus -> Bool
isThreadFinished = \case
  ThreadStopStatus
ThreadFinished -> Bool
True
  ThreadStopStatus
_otherwise -> Bool
False

{- |
Internal helper.
Show `EventInfo` in a condensed format suitable for logging.
-}
showEventInfo :: EventInfo -> String
showEventInfo :: EventInfo -> String
showEventInfo = \case
  E.RunThread{ThreadId
thread :: EventInfo -> ThreadId
thread :: ThreadId
thread} -> String -> ThreadId -> String
forall r. PrintfType r => String -> r
printf String
"RunThread{%d}" ThreadId
thread
  E.StopThread{ThreadId
thread :: EventInfo -> ThreadId
thread :: ThreadId
thread, ThreadStopStatus
status :: EventInfo -> ThreadStopStatus
status :: ThreadStopStatus
status} -> String -> ThreadId -> String -> String
forall r. PrintfType r => String -> r
printf String
"StopThread{%d,%s}" ThreadId
thread (ThreadStopStatus -> String
E.showThreadStopStatus ThreadStopStatus
status)
  E.MigrateThread{ThreadId
thread :: EventInfo -> ThreadId
thread :: ThreadId
thread} -> String -> ThreadId -> String
forall r. PrintfType r => String -> r
printf String
"MigrateThread{%d}" ThreadId
thread
  E.StartGC{} -> String
"StartGC"
  E.EndGC{} -> String
"EndGC"
  EventInfo
evSpec -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (String -> String) -> (EventInfo -> String) -> EventInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventInfo -> String
forall a. Show a => a -> String
show (EventInfo -> String) -> EventInfo -> String
forall a b. (a -> b) -> a -> b
$ EventInfo
evSpec

{- |
Internal helper. Return the minimal value by some projection.
-}
minBy :: (Ord b) => (a -> b) -> a -> a -> a
minBy :: forall b a. Ord b => (a -> b) -> a -> a -> a
minBy a -> b
f a
x a
y = if a -> b
f a
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< a -> b
f a
y then a
x else a
y