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

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

  -- ** Capability Usage Metrics
  processCapabilityUsageMetrics,

  -- ** Capability Usage Spans
  CapabilityUsageSpan,
  CapabilityUser (..),
  capabilityUser,
  showCapabilityUserCategory,
  processCapabilityUsageSpans,
  processCapabilityUsageSpans',

  -- ** GC Spans
  GCSpan (..),
  processGCSpans,
  processGCSpans',

  -- ** Mutator Spans
  MutatorSpan (..),
  asMutatorSpans,
  asMutatorSpans',
  processMutatorSpans,
  processMutatorSpans',
) where

import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Char (isSpace)
import Data.Foldable (for_)
import Data.Machine (Is (..), PlanT, ProcessT, asParts, await, construct, mapping, repeatedly, yield, (~>))
import Data.Machine.Fanout (fanout)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import GHC.Eventlog.Live.Data.Attribute (AttrValue, IsAttrValue (..), (~=))
import GHC.Eventlog.Live.Data.Metric (Metric (..))
import GHC.Eventlog.Live.Data.Span (duration)
import GHC.Eventlog.Live.Logger (logWarning)
import GHC.Eventlog.Live.Machine.Analysis.Thread (ThreadState (..), ThreadStateSpan (..), processThreadStateSpans')
import GHC.Eventlog.Live.Machine.Core (liftRouter)
import GHC.Eventlog.Live.Machine.WithStartTime (WithStartTime (..), setWithStartTime'value, tryGetTimeUnixNano)
import GHC.Eventlog.Live.Verbosity (Verbosity)
import GHC.RTS.Events (Event (..), EventInfo, ThreadId, Timestamp)
import GHC.RTS.Events qualified as E
import GHC.Records (HasField (..))
import Text.Printf (printf)

-------------------------------------------------------------------------------
-- Capability Usage Metrics

{- |
This machine processes t`CapabilityUsageSpan` spans and produces metrics that
contain the duration and category of each such span and each idle period in
between.
-}
processCapabilityUsageMetrics ::
  forall m.
  (MonadIO m) =>
  ProcessT m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
processCapabilityUsageMetrics :: forall (m :: * -> *).
MonadIO m =>
ProcessT m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
processCapabilityUsageMetrics =
  (WithStartTime CapabilityUsageSpan -> Maybe Int)
-> (Int
    -> ProcessT
         m (WithStartTime CapabilityUsageSpan) (Metric Timestamp))
-> ProcessT
     m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
forall (m :: * -> *) k a b.
(MonadIO m, Hashable k) =>
(a -> Maybe k) -> (k -> ProcessT m a b) -> ProcessT m a b
liftRouter WithStartTime CapabilityUsageSpan -> Maybe Int
measure Int
-> ProcessT
     m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
spawn
 where
  measure :: WithStartTime CapabilityUsageSpan -> Maybe Int
  measure :: WithStartTime CapabilityUsageSpan -> Maybe Int
measure = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> (WithStartTime CapabilityUsageSpan -> Int)
-> WithStartTime CapabilityUsageSpan
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.value.cap)

  spawn :: Int -> ProcessT m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
  spawn :: Int
-> ProcessT
     m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
spawn Int
cap = PlanT
  (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
-> ProcessT
     m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (PlanT
   (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
 -> ProcessT
      m (WithStartTime CapabilityUsageSpan) (Metric Timestamp))
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
-> ProcessT
     m (WithStartTime CapabilityUsageSpan) (Metric Timestamp)
forall a b. (a -> b) -> a -> b
$ Maybe CapabilityUsageSpan
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
go Maybe CapabilityUsageSpan
forall a. Maybe a
Nothing
   where
    go ::
      Maybe CapabilityUsageSpan ->
      PlanT (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
    go :: Maybe CapabilityUsageSpan
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
go Maybe CapabilityUsageSpan
mi =
      PlanT
  (Is (WithStartTime CapabilityUsageSpan))
  (Metric Timestamp)
  m
  (WithStartTime CapabilityUsageSpan)
Plan
  (Is (WithStartTime CapabilityUsageSpan))
  (Metric Timestamp)
  (WithStartTime CapabilityUsageSpan)
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT
  (Is (WithStartTime CapabilityUsageSpan))
  (Metric Timestamp)
  m
  (WithStartTime CapabilityUsageSpan)
-> (WithStartTime CapabilityUsageSpan
    -> PlanT
         (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void)
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
forall a b.
PlanT
  (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m a
-> (a
    -> PlanT
         (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m b)
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WithStartTime CapabilityUsageSpan
j -> do
        -- If there is a previous span, and...
        Maybe CapabilityUsageSpan
-> (CapabilityUsageSpan
    -> PlanT
         (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ())
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe CapabilityUsageSpan
mi ((CapabilityUsageSpan
  -> PlanT
       (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ())
 -> PlanT
      (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ())
-> (CapabilityUsageSpan
    -> PlanT
         (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ())
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ()
forall a b. (a -> b) -> a -> b
$ \CapabilityUsageSpan
i ->
          -- ...the end time of the previous span precedes the start time of the current span, then...
          Bool
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ()
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CapabilityUsageSpan
i.endTimeUnixNano Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
< WithStartTime CapabilityUsageSpan
j.value.startTimeUnixNano) (PlanT
   (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ()
 -> PlanT
      (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ())
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ()
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m ()
forall a b. (a -> b) -> a -> b
$
            -- ...yield an idle duration metric.
            Metric Timestamp
-> Plan
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) ()
forall o (k :: * -> *). o -> Plan k o ()
yield
              Metric
                { value :: Timestamp
value = WithStartTime CapabilityUsageSpan
j.value.startTimeUnixNano Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
- CapabilityUsageSpan
i.endTimeUnixNano
                , maybeTimeUnixNano :: Maybe Timestamp
maybeTimeUnixNano = Timestamp -> Maybe Timestamp
forall a. a -> Maybe a
Just CapabilityUsageSpan
i.endTimeUnixNano
                , maybeStartTimeUnixNano :: Maybe Timestamp
maybeStartTimeUnixNano = WithStartTime CapabilityUsageSpan
j.maybeStartTimeUnixNano
                , attr :: [Attr]
attr = [Text
"cap" Text -> Int -> Attr
forall v. IsAttrValue v => Text -> v -> Attr
~= Int
cap, Text
"category" Text -> Text -> Attr
forall v. IsAttrValue v => Text -> v -> Attr
~= (Text
"Idle" :: Text)]
                }
        -- Yield a duration metric for the current span.
        let user :: CapabilityUser
user = CapabilityUsageSpan -> CapabilityUser
capabilityUser WithStartTime CapabilityUsageSpan
j.value
        Metric Timestamp
-> Plan
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) ()
forall o (k :: * -> *). o -> Plan k o ()
yield
          Metric
            { value :: Timestamp
value = CapabilityUsageSpan -> Timestamp
forall s. IsSpan s => s -> Timestamp
duration WithStartTime CapabilityUsageSpan
j.value
            , maybeTimeUnixNano :: Maybe Timestamp
maybeTimeUnixNano = Timestamp -> Maybe Timestamp
forall a. a -> Maybe a
Just WithStartTime CapabilityUsageSpan
j.value.startTimeUnixNano
            , maybeStartTimeUnixNano :: Maybe Timestamp
maybeStartTimeUnixNano = WithStartTime CapabilityUsageSpan
j.maybeStartTimeUnixNano
            , attr :: [Attr]
attr = [Text
"cap" Text -> Int -> Attr
forall v. IsAttrValue v => Text -> v -> Attr
~= Int
cap, Text
"category" Text -> Text -> Attr
forall v. IsAttrValue v => Text -> v -> Attr
~= CapabilityUser -> Text
showCapabilityUserCategory CapabilityUser
user, Text
"user" Text -> CapabilityUser -> Attr
forall v. IsAttrValue v => Text -> v -> Attr
~= CapabilityUser
user]
            }
        Maybe CapabilityUsageSpan
-> PlanT
     (Is (WithStartTime CapabilityUsageSpan)) (Metric Timestamp) m Void
go (CapabilityUsageSpan -> Maybe CapabilityUsageSpan
forall a. a -> Maybe a
Just WithStartTime CapabilityUsageSpan
j.value)

{- |
The type of process using a capability,
which is either a mutator thread or garbage collection.
-}
data CapabilityUser
  = GC
  | Mutator {CapabilityUser -> ThreadId
thread :: !ThreadId}

instance Show CapabilityUser where
  show :: CapabilityUser -> String
  show :: CapabilityUser -> String
show = \case
    CapabilityUser
GC -> String
"GC"
    Mutator{ThreadId
thread :: CapabilityUser -> ThreadId
thread :: ThreadId
thread} -> ThreadId -> String
forall a. Show a => a -> String
show ThreadId
thread

instance IsAttrValue CapabilityUser where
  toAttrValue :: CapabilityUser -> AttrValue
  toAttrValue :: CapabilityUser -> AttrValue
toAttrValue = String -> AttrValue
forall v. IsAttrValue v => v -> AttrValue
toAttrValue (String -> AttrValue)
-> (CapabilityUser -> String) -> CapabilityUser -> AttrValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CapabilityUser -> String
forall a. Show a => a -> String
show
  {-# INLINE toAttrValue #-}

{- |
Get the t`CapabilityUser` associated with a t`CapabilityUsageSpan`.
-}
capabilityUser :: CapabilityUsageSpan -> CapabilityUser
capabilityUser :: CapabilityUsageSpan -> CapabilityUser
capabilityUser = (GCSpan -> CapabilityUser)
-> (MutatorSpan -> CapabilityUser)
-> CapabilityUsageSpan
-> CapabilityUser
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CapabilityUser -> GCSpan -> CapabilityUser
forall a b. a -> b -> a
const CapabilityUser
GC) (ThreadId -> CapabilityUser
Mutator (ThreadId -> CapabilityUser)
-> (MutatorSpan -> ThreadId) -> MutatorSpan -> CapabilityUser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.thread))

{- |
Show the category of a `CapabilityUser` as either @"GC"@ or @"Mutator"@.
-}
showCapabilityUserCategory :: CapabilityUser -> Text
showCapabilityUserCategory :: CapabilityUser -> Text
showCapabilityUserCategory = \case
  GC{} -> Text
"GC"
  Mutator{} -> Text
"Mutator"

-------------------------------------------------------------------------------
-- Capability Usage Spans

{- |
A t`CapabilityUsageSpan` is either a t`GCSpan` or a t`MutatorSpan`.
-}
type CapabilityUsageSpan = Either GCSpan MutatorSpan

instance HasField "startTimeUnixNano" CapabilityUsageSpan Timestamp where
  getField :: CapabilityUsageSpan -> Timestamp
  getField :: CapabilityUsageSpan -> Timestamp
getField = (GCSpan -> Timestamp)
-> (MutatorSpan -> Timestamp) -> CapabilityUsageSpan -> Timestamp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (.startTimeUnixNano) (.startTimeUnixNano)

instance HasField "endTimeUnixNano" CapabilityUsageSpan Timestamp where
  getField :: CapabilityUsageSpan -> Timestamp
  getField :: CapabilityUsageSpan -> Timestamp
getField = (GCSpan -> Timestamp)
-> (MutatorSpan -> Timestamp) -> CapabilityUsageSpan -> Timestamp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (.endTimeUnixNano) (.endTimeUnixNano)

instance HasField "cap" CapabilityUsageSpan Int where
  getField :: CapabilityUsageSpan -> Int
  getField :: CapabilityUsageSpan -> Int
getField = (GCSpan -> Int)
-> (MutatorSpan -> Int) -> CapabilityUsageSpan -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (.cap) (.cap)

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

{- |
This machine runs `processGCSpans` and `processMutatorSpans` in parallel and
combines their output.

This is effectively a fanout of `processGCSpans` and `processMutatorSpans`, the
latter of which runs `processThreadStateSpans` internally. If you are running
`processThreadStateSpans` as well, then using `asMutatorSpans` and constructing
the fanout yourself is more efficient.
-}
processCapabilityUsageSpans ::
  forall m.
  (MonadIO m) =>
  Verbosity ->
  ProcessT m (WithStartTime Event) (WithStartTime CapabilityUsageSpan)
processCapabilityUsageSpans :: forall (m :: * -> *).
MonadIO m =>
Verbosity
-> ProcessT
     m (WithStartTime Event) (WithStartTime CapabilityUsageSpan)
processCapabilityUsageSpans Verbosity
verbosity =
  (WithStartTime Event -> Maybe Timestamp)
-> (WithStartTime Event -> Event)
-> (WithStartTime Event -> GCSpan -> WithStartTime GCSpan)
-> (WithStartTime Event
    -> MutatorSpan -> WithStartTime MutatorSpan)
-> Verbosity
-> ProcessT
     m
     (WithStartTime Event)
     (Either (WithStartTime GCSpan) (WithStartTime MutatorSpan))
forall (m :: * -> *) s t1 t2.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> GCSpan -> t1)
-> (s -> MutatorSpan -> t2)
-> Verbosity
-> ProcessT m s (Either t1 t2)
processCapabilityUsageSpans' WithStartTime Event -> Maybe Timestamp
tryGetTimeUnixNano (.value) WithStartTime Event -> GCSpan -> WithStartTime GCSpan
forall a b. WithStartTime a -> b -> WithStartTime b
setWithStartTime'value WithStartTime Event -> MutatorSpan -> WithStartTime MutatorSpan
forall a b. WithStartTime a -> b -> WithStartTime b
setWithStartTime'value Verbosity
verbosity
    ProcessT
  m
  (WithStartTime Event)
  (Either (WithStartTime GCSpan) (WithStartTime MutatorSpan))
-> ProcessT
     m
     (Either (WithStartTime GCSpan) (WithStartTime MutatorSpan))
     (WithStartTime CapabilityUsageSpan)
-> MachineT
     m (Is (WithStartTime Event)) (WithStartTime CapabilityUsageSpan)
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> (Either (WithStartTime GCSpan) (WithStartTime MutatorSpan)
 -> WithStartTime CapabilityUsageSpan)
-> Machine
     (Is (Either (WithStartTime GCSpan) (WithStartTime MutatorSpan)))
     (WithStartTime CapabilityUsageSpan)
forall (k :: * -> * -> *) a b.
Category k =>
(a -> b) -> Machine (k a) b
mapping ((WithStartTime GCSpan -> WithStartTime CapabilityUsageSpan)
-> (WithStartTime MutatorSpan -> WithStartTime CapabilityUsageSpan)
-> Either (WithStartTime GCSpan) (WithStartTime MutatorSpan)
-> WithStartTime CapabilityUsageSpan
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((GCSpan -> CapabilityUsageSpan)
-> WithStartTime GCSpan -> WithStartTime CapabilityUsageSpan
forall a b. (a -> b) -> WithStartTime a -> WithStartTime b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GCSpan -> CapabilityUsageSpan
forall a b. a -> Either a b
Left) ((MutatorSpan -> CapabilityUsageSpan)
-> WithStartTime MutatorSpan -> WithStartTime CapabilityUsageSpan
forall a b. (a -> b) -> WithStartTime a -> WithStartTime b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutatorSpan -> CapabilityUsageSpan
forall a b. b -> Either a b
Right))

{- |
Generalised version of `processCapabilityUsageSpans` that can be adapted to
work on arbitrary types using a getter and a pair of lenses.
-}
processCapabilityUsageSpans' ::
  forall m s t1 t2.
  (MonadIO m) =>
  (s -> Maybe Timestamp) ->
  (s -> Event) ->
  (s -> GCSpan -> t1) ->
  (s -> MutatorSpan -> t2) ->
  Verbosity ->
  ProcessT m s (Either t1 t2)
processCapabilityUsageSpans' :: forall (m :: * -> *) s t1 t2.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> GCSpan -> t1)
-> (s -> MutatorSpan -> t2)
-> Verbosity
-> ProcessT m s (Either t1 t2)
processCapabilityUsageSpans' s -> Maybe Timestamp
timeUnixNano s -> Event
getEvent s -> GCSpan -> t1
setGCSpan s -> MutatorSpan -> t2
setMutatorSpan Verbosity
verbosity =
  -- NOTE:
  -- Combining this fanout with an `Either` is risky, because it
  -- has the potential to lose information if both `processGCSpans`
  -- and `processMutatorSpans` yield a value for the same input.
  -- However, this shouldn't ever happen, since the two processors
  -- process disjoint sets of events.
  [ProcessT m s (Either t1 t2)] -> ProcessT m s (Either t1 t2)
forall (m :: * -> *) a r.
(Monad m, Semigroup r) =>
[ProcessT m a r] -> ProcessT m a r
fanout
    [ (s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> GCSpan -> t1)
-> Verbosity
-> ProcessT m s t1
forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> GCSpan -> t)
-> Verbosity
-> ProcessT m s t
processGCSpans' s -> Maybe Timestamp
timeUnixNano s -> Event
getEvent s -> GCSpan -> t1
setGCSpan Verbosity
verbosity
        ProcessT m s t1
-> ProcessT m t1 (Either t1 t2) -> ProcessT m s (Either t1 t2)
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> (t1 -> Either t1 t2) -> Machine (Is t1) (Either t1 t2)
forall (k :: * -> * -> *) a b.
Category k =>
(a -> b) -> Machine (k a) b
mapping t1 -> Either t1 t2
forall a b. a -> Either a b
Left
    , (s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> MutatorSpan -> t2)
-> Verbosity
-> ProcessT m s t2
forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> MutatorSpan -> t)
-> Verbosity
-> ProcessT m s t
processMutatorSpans' s -> Maybe Timestamp
timeUnixNano s -> Event
getEvent s -> MutatorSpan -> t2
setMutatorSpan Verbosity
verbosity
        ProcessT m s t2
-> ProcessT m t2 (Either t1 t2) -> ProcessT m s (Either t1 t2)
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> (t2 -> Either t1 t2) -> Machine (Is t2) (Either t1 t2)
forall (k :: * -> * -> *) a b.
Category k =>
(a -> b) -> Machine (k a) b
mapping t2 -> Either t1 t2
forall a b. b -> Either a b
Right
    ]

-------------------------------------------------------------------------------
-- GC spans

{- |
A t`GCSpan` represents a segment of time during which the specified capability
ran GC.
-}
data GCSpan = GCSpan
  { GCSpan -> Int
cap :: !Int
  , GCSpan -> Timestamp
startTimeUnixNano :: !Timestamp
  , GCSpan -> Timestamp
endTimeUnixNano :: !Timestamp
  }
  deriving (Int -> GCSpan -> String -> String
[GCSpan] -> String -> String
GCSpan -> String
(Int -> GCSpan -> String -> String)
-> (GCSpan -> String)
-> ([GCSpan] -> String -> String)
-> Show GCSpan
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GCSpan -> String -> String
showsPrec :: Int -> GCSpan -> String -> String
$cshow :: GCSpan -> String
show :: GCSpan -> String
$cshowList :: [GCSpan] -> String -> String
showList :: [GCSpan] -> String -> String
Show)

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

{- |
This machine processes `E.StartGC` and `E.EndGC` events to produce t`GCSpan`
values that represent the segments of time a capability spent in GC.

This processor uses the following finite-state automaton:

@
      ┌─(EndGC)───┐
      │           ↓
    ┌→[   Idle    ]─┐
    │               │
(EndGC)         (StartGC)
    │               │
    └─[    GC     ]←┘
      ↑           │
      └─(StartGC)─┘
@

The transition from @GC@ to @Idle@ yields a GC span.
-}
processGCSpans ::
  forall m.
  (MonadIO m) =>
  Verbosity ->
  ProcessT m (WithStartTime Event) (WithStartTime GCSpan)
processGCSpans :: forall (m :: * -> *).
MonadIO m =>
Verbosity
-> ProcessT m (WithStartTime Event) (WithStartTime GCSpan)
processGCSpans =
  (WithStartTime Event -> Maybe Timestamp)
-> (WithStartTime Event -> Event)
-> (WithStartTime Event -> GCSpan -> WithStartTime GCSpan)
-> Verbosity
-> ProcessT m (WithStartTime Event) (WithStartTime GCSpan)
forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> GCSpan -> t)
-> Verbosity
-> ProcessT m s t
processGCSpans' WithStartTime Event -> Maybe Timestamp
tryGetTimeUnixNano (.value) WithStartTime Event -> GCSpan -> WithStartTime GCSpan
forall a b. WithStartTime a -> b -> WithStartTime b
setWithStartTime'value

{- |
Generalised version of `processGCSpans` that can be adapted to work on
arbitrary types using a getter and a lens.
-}
processGCSpans' ::
  forall m s t.
  (MonadIO m) =>
  (s -> Maybe Timestamp) ->
  (s -> Event) ->
  (s -> GCSpan -> t) ->
  Verbosity ->
  ProcessT m s t
processGCSpans' :: forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> GCSpan -> t)
-> Verbosity
-> ProcessT m s t
processGCSpans' s -> Maybe Timestamp
timeUnixNano s -> Event
getEvent s -> GCSpan -> t
setGCSpan Verbosity
verbosity =
  (s -> Maybe Int) -> (Int -> 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 Int
measure Int -> 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 Int
  measure :: s -> Maybe Int
measure s
i
    | EventInfo -> Bool
accept (s -> EventInfo
getEventInfo s
i) = s -> Maybe Int
getEventCap s
i
    | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
   where
    accept :: EventInfo -> Bool
accept E.StartGC{} = Bool
True
    accept E.EndGC{} = Bool
True
    accept EventInfo
_ = Bool
False

  -- TODO: Rewrite using `MealyT`
  spawn :: Int -> ProcessT m s t
  spawn :: Int -> ProcessT m s t
spawn Int
cap = 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
    -- The "mi" variable tracks the previous event for this capability, which
    -- is either `Nothing` or `Just` a `StartGC` or a `EndGC` event.
    go :: Maybe s -> PlanT (Is s) t m Void
    go :: Maybe s -> PlanT (Is s) t m Void
go Maybe s
mi =
      -- We start by awaiting the next event "j"...
      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
>>= \s
j -> case s -> EventInfo
getEventInfo s
j of
        -- If the next event is a `RunThread` event, and...
        E.StartGC{} -> case Maybe s
mi of
          Just s
i
            -- If the previous event was a `StartGC` event, then...
            | E.StartGC{} <- s -> EventInfo
getEventInfo s
i ->
                -- ...continue with 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 -> Timestamp) -> s -> s -> s
forall b a. Ord b => (a -> b) -> a -> a -> a
minBy s -> Timestamp
getEventTime s
i s
j)
            -- If the previous event was a `EndGC` event, then...
            | E.EndGC{} <- s -> EventInfo
getEventInfo s
i ->
                -- ...continue with 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 previous event was 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 -> Int -> String -> String -> String
forall r. PrintfType r => String -> r
printf
                    String
"Capability %d: Unsupported trace %s --> %s"
                    Int
cap
                    (EventInfo -> String
showEventInfo (s -> EventInfo
getEventInfo s
i))
                    (EventInfo -> String
showEventInfo (s -> EventInfo
getEventInfo s
j))
                -- ...continue with the previous event.
                Maybe s -> PlanT (Is s) t m Void
go (s -> Maybe s
forall a. a -> Maybe a
Just s
i)
          -- If there was no previous event, then...
          Maybe s
Nothing ->
            -- ...continue with 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 next event is a `StopThread` event...
        E.EndGC{} -> case Maybe s
mi of
          Just s
i
            -- If the previous event was a `StartGC` event, then...
            | E.StartGC{} <- s -> EventInfo
getEventInfo s
i
            , Just Timestamp
startTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano s
i
            , Just Timestamp
endTimeUnixNano <- s -> Maybe Timestamp
timeUnixNano s
j -> do
                -- ...yield a GC 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 ())
-> (GCSpan -> t) -> GCSpan -> PlanT (Is s) t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> GCSpan -> t
setGCSpan s
j (GCSpan -> PlanT (Is s) t m ()) -> GCSpan -> PlanT (Is s) t m ()
forall a b. (a -> b) -> a -> b
$ GCSpan{Int
Timestamp
cap :: Int
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
cap :: Int
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
..}
                -- ...continue with 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 previous event was a `EndGC` event, then...
            | E.EndGC{} <- s -> EventInfo
getEventInfo s
i ->
                -- ...continue with 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 -> Timestamp) -> s -> s -> s
forall b a. Ord b => (a -> b) -> a -> a -> a
minBy s -> Timestamp
getEventTime s
i s
j)
          -- If there was no previous event or it was any other event, then...
          Maybe s
_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 -> Int -> String -> String -> String
forall r. PrintfType r => String -> r
printf
                String
"Capability %d: Unsupported trace %s --> %s"
                Int
cap
                (String -> (s -> String) -> Maybe s -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"?" (EventInfo -> String
showEventInfo (EventInfo -> String) -> (s -> EventInfo) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> EventInfo
getEventInfo) Maybe s
mi)
                (EventInfo -> String
showEventInfo (s -> EventInfo
getEventInfo s
j))
            -- ...continue with the previous event.
            Maybe s -> PlanT (Is s) t m Void
go Maybe s
mi
        -- If the next event is any other event, ignore it.
        EventInfo
_otherwise -> Maybe s -> PlanT (Is s) t m Void
go Maybe s
mi

-------------------------------------------------------------------------------
-- Mutator spans

{- |
A t`MutatorSpan` represents a segment of time during which the specified
capability ran the specified mutator thread.
-}
data MutatorSpan = MutatorSpan
  { MutatorSpan -> Int
cap :: !Int
  , MutatorSpan -> ThreadId
thread :: !ThreadId
  , MutatorSpan -> Timestamp
startTimeUnixNano :: !Timestamp
  , MutatorSpan -> Timestamp
endTimeUnixNano :: !Timestamp
  }
  deriving (Int -> MutatorSpan -> String -> String
[MutatorSpan] -> String -> String
MutatorSpan -> String
(Int -> MutatorSpan -> String -> String)
-> (MutatorSpan -> String)
-> ([MutatorSpan] -> String -> String)
-> Show MutatorSpan
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> MutatorSpan -> String -> String
showsPrec :: Int -> MutatorSpan -> String -> String
$cshow :: MutatorSpan -> String
show :: MutatorSpan -> String
$cshowList :: [MutatorSpan] -> String -> String
showList :: [MutatorSpan] -> String -> String
Show)

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

{- |
This machine processes `E.RunThread` and `E.StopThread` events to produce
t`MutatorSpan` values that represent the segments of time a capability spent
executating a mutator.

This processor uses the following finite-state automaton:

@
      ┌─(StopThread[X])─┐
      │                 ↓
    ┌→[      Idle       ]─┐
    │                     │
(StopThread[X])       (RunThread[X])
    │                     │
    └─[   Mutator[X]    ]←┘
      ↑                 │
      └─(RunThread[X])──┘
@

The transition from @Mutator[X]@ to @Idle@ yields a t`MutatorSpan`.
While in the @Mutator[X]@ state, any @RunThread[Y]@ or @StopThread[Y]@ events result in an error.
Furthermore, when a @StopThread[X]@ event with the @ThreadFinished@ status is processed,
the thread @X@ is added to a set of finished threads,
and any further @RunThread[X]@ events for that thread are ignored.
This is done because the GHC RTS frequently emits a @RunThread[X]@ event
immediately after a @StopThread[X]@ event with the @ThreadFinished@ status.

This runs `processThreadStateSpans` internally. If you are also running
`processThreadStateSpans`, then post-composing it with `asMutatorSpans`
is more efficient.
-}
processMutatorSpans ::
  forall m.
  (MonadIO m) =>
  Verbosity ->
  ProcessT m (WithStartTime Event) (WithStartTime MutatorSpan)
processMutatorSpans :: forall (m :: * -> *).
MonadIO m =>
Verbosity
-> ProcessT m (WithStartTime Event) (WithStartTime MutatorSpan)
processMutatorSpans =
  (WithStartTime Event -> Maybe Timestamp)
-> (WithStartTime Event -> Event)
-> (WithStartTime Event
    -> MutatorSpan -> WithStartTime MutatorSpan)
-> Verbosity
-> ProcessT m (WithStartTime Event) (WithStartTime MutatorSpan)
forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> MutatorSpan -> t)
-> Verbosity
-> ProcessT m s t
processMutatorSpans' WithStartTime Event -> Maybe Timestamp
tryGetTimeUnixNano (.value) WithStartTime Event -> MutatorSpan -> WithStartTime MutatorSpan
forall a b. WithStartTime a -> b -> WithStartTime b
setWithStartTime'value

{- |
Generalised version of `processMutatorSpans` that can be adapted to work on
arbitrary types using a getter and a lens.
-}
processMutatorSpans' ::
  forall m s t.
  (MonadIO m) =>
  (s -> Maybe Timestamp) ->
  (s -> Event) ->
  (s -> MutatorSpan -> t) ->
  Verbosity ->
  ProcessT m s t
processMutatorSpans' :: forall (m :: * -> *) s t.
MonadIO m =>
(s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> MutatorSpan -> t)
-> Verbosity
-> ProcessT m s t
processMutatorSpans' s -> Maybe Timestamp
timeUnixNano s -> Event
getEvent s -> MutatorSpan -> t
setMutatorSpan Verbosity
verbosity =
  (s -> Maybe Timestamp)
-> (s -> Event)
-> (s -> ThreadStateSpan -> Maybe t)
-> Verbosity
-> ProcessT m s (Maybe t)
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 -> Maybe t
setThreadStateSpan Verbosity
verbosity ProcessT m s (Maybe t)
-> ProcessT m (Maybe t) t -> MachineT m (Is s) t
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> ProcessT m (Maybe t) t
Process (Maybe t) t
forall (f :: * -> *) a. Foldable f => Process (f a) a
asParts
 where
  setThreadStateSpan :: s -> ThreadStateSpan -> Maybe t
  setThreadStateSpan :: s -> ThreadStateSpan -> Maybe t
setThreadStateSpan s
s ThreadStateSpan
threadStateSpan =
    s -> MutatorSpan -> t
setMutatorSpan s
s (MutatorSpan -> t) -> Maybe MutatorSpan -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreadStateSpan -> Maybe MutatorSpan
threadStateSpanToMutatorSpan ThreadStateSpan
threadStateSpan

{- |
This machine converts any `Running` t`ThreadStateSpan` to a t`MutatorSpan`.
-}
asMutatorSpans ::
  forall m.
  (MonadIO m) =>
  ProcessT m ThreadStateSpan MutatorSpan
asMutatorSpans :: forall (m :: * -> *).
MonadIO m =>
ProcessT m ThreadStateSpan MutatorSpan
asMutatorSpans = (ThreadStateSpan -> ThreadStateSpan)
-> (ThreadStateSpan -> MutatorSpan -> MutatorSpan)
-> ProcessT m ThreadStateSpan MutatorSpan
forall (m :: * -> *) s t.
MonadIO m =>
(s -> ThreadStateSpan) -> (s -> MutatorSpan -> t) -> ProcessT m s t
asMutatorSpans' ThreadStateSpan -> ThreadStateSpan
forall a. a -> a
id ((MutatorSpan -> MutatorSpan)
-> ThreadStateSpan -> MutatorSpan -> MutatorSpan
forall a b. a -> b -> a
const MutatorSpan -> MutatorSpan
forall a. a -> a
id)

{- |
Generalised version of `asMutatorSpans` that can be adapted to work on
arbitrary types using a getter and a lens.
-}
asMutatorSpans' ::
  forall m s t.
  (MonadIO m) =>
  (s -> ThreadStateSpan) ->
  (s -> MutatorSpan -> t) ->
  ProcessT m s t
asMutatorSpans' :: forall (m :: * -> *) s t.
MonadIO m =>
(s -> ThreadStateSpan) -> (s -> MutatorSpan -> t) -> ProcessT m s t
asMutatorSpans' s -> ThreadStateSpan
getThreadStateSpan s -> MutatorSpan -> t
setMutatorSpan = PlanT (Is s) t m () -> MachineT m (Is s) t
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly PlanT (Is s) t m ()
go
 where
  go :: PlanT (Is s) t m ()
go =
    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 ()) -> PlanT (Is s) t m ()
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
>>= \s
s -> do
      let threadStateSpan :: ThreadStateSpan
threadStateSpan = s -> ThreadStateSpan
getThreadStateSpan s
s
      let maybeMutatorSpan :: Maybe MutatorSpan
maybeMutatorSpan = ThreadStateSpan -> Maybe MutatorSpan
threadStateSpanToMutatorSpan ThreadStateSpan
threadStateSpan
      Maybe MutatorSpan
-> (MutatorSpan -> PlanT (Is s) t m ()) -> PlanT (Is s) t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe MutatorSpan
maybeMutatorSpan ((MutatorSpan -> PlanT (Is s) t m ()) -> PlanT (Is s) t m ())
-> (MutatorSpan -> PlanT (Is s) t m ()) -> PlanT (Is s) t m ()
forall a b. (a -> b) -> a -> b
$ 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 ())
-> (MutatorSpan -> t) -> MutatorSpan -> PlanT (Is s) t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> MutatorSpan -> t
setMutatorSpan s
s

{- |
Convert the `Running` t`ThreadStateSpan` to `Just` a t`MutatorSpan`.
-}
threadStateSpanToMutatorSpan :: ThreadStateSpan -> Maybe MutatorSpan
threadStateSpanToMutatorSpan :: ThreadStateSpan -> Maybe MutatorSpan
threadStateSpanToMutatorSpan ThreadStateSpan{ThreadId
Timestamp
ThreadState
thread :: ThreadId
threadState :: ThreadState
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
endTimeUnixNano :: ThreadStateSpan -> Timestamp
startTimeUnixNano :: ThreadStateSpan -> Timestamp
threadState :: ThreadStateSpan -> ThreadState
thread :: ThreadStateSpan -> ThreadId
..} =
  case ThreadState
threadState of
    Running{Int
cap :: Int
cap :: ThreadState -> Int
..} -> MutatorSpan -> Maybe MutatorSpan
forall a. a -> Maybe a
Just MutatorSpan{Int
ThreadId
Timestamp
cap :: Int
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
thread :: ThreadId
startTimeUnixNano :: Timestamp
endTimeUnixNano :: Timestamp
cap :: Int
..}
    ThreadState
_otherwise -> Maybe MutatorSpan
forall a. Maybe a
Nothing

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

{- |
Internal helper.
Show `EventInfo` in a condensed format suitable for logging.
-}
showEventInfo :: EventInfo -> String
showEventInfo :: EventInfo -> String
showEventInfo = \case
  E.RunThread{ThreadId
thread :: ThreadId
thread :: EventInfo -> 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 :: ThreadStopStatus
status :: EventInfo -> 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