{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

module Cardano.Node.Tracing.Tracers.ForgingThreadStats
  ( ForgingStats (..)
  , ForgeThreadStats (..)
  , forgeThreadStats
  , docForgeStats
  ) where

import           Cardano.Logging
import           Cardano.Prelude hiding (All, concat, (:.:))
import           Data.Aeson (Value (..), (.=))
import qualified Data.Map.Strict as Map

import           Cardano.Node.Tracing.Tracers.StartLeadershipCheck (ForgeTracerType,
                   TraceStartLeadershipCheckPlus)
import           Cardano.Slotting.Slot (SlotNo (..))
import           Ouroboros.Consensus.Node.Tracers
import qualified Ouroboros.Consensus.Node.Tracers as Consensus
import           Ouroboros.Consensus.Shelley.Node ()

--------------------------------------------------------------------------------
-- ForgeThreadStats Tracer
--------------------------------------------------------------------------------

-- | Per-forging-thread statistics.
data ForgeThreadStats = ForgeThreadStats
  { ForgeThreadStats -> Int
ftsNodeCannotForgeNum :: !Int
  , ForgeThreadStats -> Int
ftsNodeIsLeaderNum    :: !Int
  , ForgeThreadStats -> Int
ftsBlocksForgedNum    :: !Int
  , ForgeThreadStats -> Int
ftsSlotsMissedNum     :: !Int
    -- ^ Potentially missed slots.  Note that this is not the same as the number
    -- of missed blocks, since this includes all occurrences of not reaching a
    -- leadership check decision, whether or not leadership was possible or not.
    --
    -- Also note that when the aggregate total for this metric is reported in the
    -- multi-pool case, it can be much larger than the actual number of slots
    -- occurring since node start, for it is a sum total for all threads.
  , ForgeThreadStats -> Int
ftsLastSlot           :: !Int
  }

instance LogFormatting ForgeThreadStats where
  forHuman :: ForgeThreadStats -> Text
forHuman ForgeThreadStats {Int
ftsLastSlot :: Int
ftsSlotsMissedNum :: Int
ftsBlocksForgedNum :: Int
ftsNodeIsLeaderNum :: Int
ftsNodeCannotForgeNum :: Int
ftsLastSlot :: ForgeThreadStats -> Int
ftsSlotsMissedNum :: ForgeThreadStats -> Int
ftsBlocksForgedNum :: ForgeThreadStats -> Int
ftsNodeIsLeaderNum :: ForgeThreadStats -> Int
ftsNodeCannotForgeNum :: ForgeThreadStats -> Int
..} =
    Text
"Node cannot forge "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
ftsNodeCannotForgeNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" node is leader " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
ftsNodeIsLeaderNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" blocks forged "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
ftsBlocksForgedNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" slots missed "   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
ftsSlotsMissedNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" last slot "      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
ftsLastSlot
  forMachine :: DetailLevel -> ForgeThreadStats -> Object
forMachine DetailLevel
_dtal ForgeThreadStats {Int
ftsLastSlot :: Int
ftsSlotsMissedNum :: Int
ftsBlocksForgedNum :: Int
ftsNodeIsLeaderNum :: Int
ftsNodeCannotForgeNum :: Int
ftsLastSlot :: ForgeThreadStats -> Int
ftsSlotsMissedNum :: ForgeThreadStats -> Int
ftsBlocksForgedNum :: ForgeThreadStats -> Int
ftsNodeIsLeaderNum :: ForgeThreadStats -> Int
ftsNodeCannotForgeNum :: ForgeThreadStats -> Int
..} =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForgeThreadStats"
             , Key
"nodeCannotForgeNum" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
ftsNodeCannotForgeNum)
             , Key
"nodeIsLeaderNum"    Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
ftsNodeIsLeaderNum)
             , Key
"blocksForgedNum"    Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
ftsBlocksForgedNum)
             , Key
"slotsMissed"        Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
ftsSlotsMissedNum)
             , Key
"lastSlot"           Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
ftsLastSlot)
             ]
  asMetrics :: ForgeThreadStats -> [Metric]
asMetrics ForgeThreadStats {Int
ftsLastSlot :: Int
ftsSlotsMissedNum :: Int
ftsBlocksForgedNum :: Int
ftsNodeIsLeaderNum :: Int
ftsNodeCannotForgeNum :: Int
ftsLastSlot :: ForgeThreadStats -> Int
ftsSlotsMissedNum :: ForgeThreadStats -> Int
ftsBlocksForgedNum :: ForgeThreadStats -> Int
ftsNodeIsLeaderNum :: ForgeThreadStats -> Int
ftsNodeCannotForgeNum :: ForgeThreadStats -> Int
..} =
    [ Text -> Integer -> Metric
IntM Text
"nodeCannotForgeNum" (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ftsNodeCannotForgeNum)
    , Text -> Integer -> Metric
IntM Text
"nodeIsLeaderNum"    (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ftsNodeIsLeaderNum)
    , Text -> Integer -> Metric
IntM Text
"blocksForgedNum"    (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ftsBlocksForgedNum)
    , Text -> Integer -> Metric
IntM Text
"slotsMissed"        (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ftsSlotsMissedNum)
    , Text -> Integer -> Metric
IntM Text
"lastSlot"           (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ftsLastSlot)
    ]


emptyForgeThreadStats :: ForgeThreadStats
emptyForgeThreadStats :: ForgeThreadStats
emptyForgeThreadStats = Int -> Int -> Int -> Int -> Int -> ForgeThreadStats
ForgeThreadStats Int
0 Int
0 Int
0 Int
0 Int
0

docForgeStats :: Documented
  (Either
      (Consensus.TraceForgeEvent blk)
      TraceStartLeadershipCheckPlus)
docForgeStats :: Documented
  (Either (TraceForgeEvent blk) TraceStartLeadershipCheckPlus)
docForgeStats = [DocMsg
   (Either (TraceForgeEvent blk) TraceStartLeadershipCheckPlus)]
-> Documented
     (Either (TraceForgeEvent blk) TraceStartLeadershipCheckPlus)
forall a. [DocMsg a] -> Documented a
Documented [
    Namespace
-> [(Text, Text)]
-> Text
-> DocMsg
     (Either (TraceForgeEvent blk) TraceStartLeadershipCheckPlus)
forall a. Namespace -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      []
      [(Text
"nodeCannotForgeNum",
        Text
"How many times this node could not forge?")
      ,(Text
"nodeIsLeaderNum",
        Text
"How many times this node was leader?")
      ,(Text
"blocksForgedNum",
        Text
"How many blocks did forge in this node?")
      ,(Text
"slotsMissed",
        Text
"How many slots were missed in this node?")
      ]
      Text
"nodeCannotForgeNum shows how many times this node could not forge.\
      \\nnodeIsLeaderNum shows how many times this node was leader.\
      \\nblocksForgedNum shows how many blocks did forge in this node.\
      \\nslotsMissed shows how many slots were missed in this node."
  ]

--------------------------------------------------------------------------------
-- ForgingStats Tracer
--------------------------------------------------------------------------------

-- | This structure stores counters of blockchain-related events,
--   per individual thread in fsStats.
data ForgingStats
  = ForgingStats
  { ForgingStats -> Map ThreadId ForgeThreadStats
fsStats              :: !(Map ThreadId ForgeThreadStats)
  , ForgingStats -> Int
fsNodeCannotForgeNum :: !Int
  , ForgingStats -> Int
fsNodeIsLeaderNum    :: !Int
  , ForgingStats -> Int
fsBlocksForgedNum    :: !Int
  , ForgingStats -> Int
fsSlotsMissedNum     :: !Int
  }

instance LogFormatting ForgingStats where
  forHuman :: ForgingStats -> Text
forHuman ForgingStats {Int
Map ThreadId ForgeThreadStats
fsSlotsMissedNum :: Int
fsBlocksForgedNum :: Int
fsNodeIsLeaderNum :: Int
fsNodeCannotForgeNum :: Int
fsStats :: Map ThreadId ForgeThreadStats
fsSlotsMissedNum :: ForgingStats -> Int
fsBlocksForgedNum :: ForgingStats -> Int
fsNodeIsLeaderNum :: ForgingStats -> Int
fsNodeCannotForgeNum :: ForgingStats -> Int
fsStats :: ForgingStats -> Map ThreadId ForgeThreadStats
..} =
    Text
"Node cannot forge "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
fsNodeCannotForgeNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" node is leader " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
fsNodeIsLeaderNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" blocks forged "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
fsBlocksForgedNum
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" slots missed "   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
fsSlotsMissedNum
  forMachine :: DetailLevel -> ForgingStats -> Object
forMachine DetailLevel
_dtal ForgingStats {Int
Map ThreadId ForgeThreadStats
fsSlotsMissedNum :: Int
fsBlocksForgedNum :: Int
fsNodeIsLeaderNum :: Int
fsNodeCannotForgeNum :: Int
fsStats :: Map ThreadId ForgeThreadStats
fsSlotsMissedNum :: ForgingStats -> Int
fsBlocksForgedNum :: ForgingStats -> Int
fsNodeIsLeaderNum :: ForgingStats -> Int
fsNodeCannotForgeNum :: ForgingStats -> Int
fsStats :: ForgingStats -> Map ThreadId ForgeThreadStats
..} =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForgingStats"
             , Key
"nodeCannotForgeNum" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
fsNodeCannotForgeNum)
             , Key
"nodeIsLeaderNum"    Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
fsNodeIsLeaderNum)
             , Key
"blocksForgedNum"    Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
fsBlocksForgedNum)
             , Key
"slotsMissed"        Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Int
fsSlotsMissedNum)
             ]
  asMetrics :: ForgingStats -> [Metric]
asMetrics ForgingStats {Int
Map ThreadId ForgeThreadStats
fsSlotsMissedNum :: Int
fsBlocksForgedNum :: Int
fsNodeIsLeaderNum :: Int
fsNodeCannotForgeNum :: Int
fsStats :: Map ThreadId ForgeThreadStats
fsSlotsMissedNum :: ForgingStats -> Int
fsBlocksForgedNum :: ForgingStats -> Int
fsNodeIsLeaderNum :: ForgingStats -> Int
fsNodeCannotForgeNum :: ForgingStats -> Int
fsStats :: ForgingStats -> Map ThreadId ForgeThreadStats
..} =
    [ Text -> Integer -> Metric
IntM Text
"nodeCannotForgeNum" (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fsNodeCannotForgeNum)
    , Text -> Integer -> Metric
IntM Text
"nodeIsLeaderNum"    (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fsNodeIsLeaderNum)
    , Text -> Integer -> Metric
IntM Text
"blocksForgedNum"    (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fsBlocksForgedNum)
    , Text -> Integer -> Metric
IntM Text
"slotsMissed"        (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fsSlotsMissedNum)
    ]

emptyForgingStats :: ForgingStats
emptyForgingStats :: ForgingStats
emptyForgingStats = Map ThreadId ForgeThreadStats
-> Int -> Int -> Int -> Int -> ForgingStats
ForgingStats Map ThreadId ForgeThreadStats
forall a. Monoid a => a
mempty Int
0 Int
0 Int
0 Int
0

forgeThreadStats :: Trace IO (Folding (ForgeTracerType blk) ForgingStats)
  -> IO (Trace IO (ForgeTracerType blk))
forgeThreadStats :: Trace IO (Folding (ForgeTracerType blk) ForgingStats)
-> IO (Trace IO (ForgeTracerType blk))
forgeThreadStats = (ForgingStats
 -> LoggingContext -> ForgeTracerType blk -> IO ForgingStats)
-> ForgingStats
-> (ForgeTracerType blk -> Bool)
-> Trace IO (Folding (ForgeTracerType blk) ForgingStats)
-> IO (Trace IO (ForgeTracerType blk))
forall a acc (m :: * -> *).
MonadUnliftIO m =>
(acc -> LoggingContext -> a -> m acc)
-> acc -> (a -> Bool) -> Trace m (Folding a acc) -> m (Trace m a)
foldMCondTraceM ForgingStats
-> LoggingContext -> ForgeTracerType blk -> IO ForgingStats
forall (m :: * -> *) blk.
MonadIO m =>
ForgingStats
-> LoggingContext -> ForgeTracerType blk -> m ForgingStats
calculateThreadStats ForgingStats
emptyForgingStats
  (\case
      Left Consensus.TraceStartLeadershipCheck{} -> Bool
True
      Left TraceForgeEvent blk
_  -> Bool
False
      Right TraceStartLeadershipCheckPlus
_ -> Bool
True)

calculateThreadStats :: MonadIO m
  => ForgingStats
  -> LoggingContext
  -> ForgeTracerType blk
  -> m ForgingStats
calculateThreadStats :: ForgingStats
-> LoggingContext -> ForgeTracerType blk -> m ForgingStats
calculateThreadStats ForgingStats
stats LoggingContext
_context
    (Left TraceNodeCannotForge {}) = do
      ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe Any))
-> (ForgingStats -> Maybe Any -> ForgingStats)
-> m ForgingStats
forall (m :: * -> *) a.
MonadIO m =>
ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe a))
-> (ForgingStats -> Maybe a -> ForgingStats)
-> m ForgingStats
mapThreadStats
        ForgingStats
stats
        (\ForgeThreadStats
fts -> (ForgeThreadStats
fts { ftsNodeCannotForgeNum :: Int
ftsNodeCannotForgeNum = ForgeThreadStats -> Int
ftsNodeCannotForgeNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
                      , Maybe Any
forall a. Maybe a
Nothing))
        (\ForgingStats
fs Maybe Any
_ ->  (ForgingStats
fs  { fsNodeCannotForgeNum :: Int
fsNodeCannotForgeNum  = ForgingStats -> Int
fsNodeCannotForgeNum ForgingStats
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }))
calculateThreadStats ForgingStats
stats LoggingContext
_context
    (Left (TraceNodeIsLeader (SlotNo Word64
slot'))) = do
      let slot :: Int
slot = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot'
      ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe Any))
-> (ForgingStats -> Maybe Any -> ForgingStats)
-> m ForgingStats
forall (m :: * -> *) a.
MonadIO m =>
ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe a))
-> (ForgingStats -> Maybe a -> ForgingStats)
-> m ForgingStats
mapThreadStats
        ForgingStats
stats
        (\ForgeThreadStats
fts -> (ForgeThreadStats
fts { ftsNodeIsLeaderNum :: Int
ftsNodeIsLeaderNum = ForgeThreadStats -> Int
ftsNodeIsLeaderNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                   , ftsLastSlot :: Int
ftsLastSlot = Int
slot}, Maybe Any
forall a. Maybe a
Nothing))
        (\ForgingStats
fs Maybe Any
_ ->  (ForgingStats
fs  { fsNodeIsLeaderNum :: Int
fsNodeIsLeaderNum  = ForgingStats -> Int
fsNodeIsLeaderNum ForgingStats
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }))
calculateThreadStats ForgingStats
stats LoggingContext
_context
    (Left TraceForgedBlock {}) = do
      ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe Any))
-> (ForgingStats -> Maybe Any -> ForgingStats)
-> m ForgingStats
forall (m :: * -> *) a.
MonadIO m =>
ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe a))
-> (ForgingStats -> Maybe a -> ForgingStats)
-> m ForgingStats
mapThreadStats
        ForgingStats
stats
        (\ForgeThreadStats
fts -> (ForgeThreadStats
fts { ftsBlocksForgedNum :: Int
ftsBlocksForgedNum = ForgeThreadStats -> Int
ftsBlocksForgedNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
                      , Maybe Any
forall a. Maybe a
Nothing))
        (\ForgingStats
fs Maybe Any
_ ->  (ForgingStats
fs  { fsBlocksForgedNum :: Int
fsBlocksForgedNum  = ForgingStats -> Int
fsBlocksForgedNum ForgingStats
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }))
calculateThreadStats ForgingStats
stats LoggingContext
_context
    (Left (TraceNodeNotLeader (SlotNo Word64
slot'))) = do
      let slot :: Int
slot = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot'
      ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe Int))
-> (ForgingStats -> Maybe Int -> ForgingStats)
-> m ForgingStats
forall (m :: * -> *) a.
MonadIO m =>
ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe a))
-> (ForgingStats -> Maybe a -> ForgingStats)
-> m ForgingStats
mapThreadStats
        ForgingStats
stats
        (\ForgeThreadStats
fts ->
          if ForgeThreadStats -> Int
ftsLastSlot ForgeThreadStats
fts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int -> Int
forall a. Enum a => a -> a
succ (ForgeThreadStats -> Int
ftsLastSlot ForgeThreadStats
fts) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slot
            then (ForgeThreadStats
fts { ftsLastSlot :: Int
ftsLastSlot = Int
slot }, Maybe Int
forall a. Maybe a
Nothing)
            else
              let missed :: Int
missed = (Int
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
- ForgeThreadStats -> Int
ftsLastSlot ForgeThreadStats
fts)
              in (ForgeThreadStats
fts { ftsLastSlot :: Int
ftsLastSlot = Int
slot
                      , ftsSlotsMissedNum :: Int
ftsSlotsMissedNum = ForgeThreadStats -> Int
ftsSlotsMissedNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
missed}
                 , Int -> Maybe Int
forall a. a -> Maybe a
Just Int
missed))
        (\ForgingStats
fs Maybe Int
mbMissed -> case Maybe Int
mbMissed of
                            Maybe Int
Nothing -> ForgingStats
fs
                            Just Int
missed -> (ForgingStats
fs { fsSlotsMissedNum :: Int
fsSlotsMissedNum =
                              ForgingStats -> Int
fsSlotsMissedNum ForgingStats
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
missed}))
calculateThreadStats ForgingStats
stats LoggingContext
_context ForgeTracerType blk
_message = ForgingStats -> m ForgingStats
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForgingStats
stats

mapThreadStats ::
     MonadIO m
  => ForgingStats
  -> (ForgeThreadStats -> (ForgeThreadStats, Maybe a))
  -> (ForgingStats -> Maybe a -> ForgingStats)
  -> m ForgingStats
mapThreadStats :: ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Maybe a))
-> (ForgingStats -> Maybe a -> ForgingStats)
-> m ForgingStats
mapThreadStats fs :: ForgingStats
fs@ForgingStats { Map ThreadId ForgeThreadStats
fsStats :: Map ThreadId ForgeThreadStats
fsStats :: ForgingStats -> Map ThreadId ForgeThreadStats
fsStats } ForgeThreadStats -> (ForgeThreadStats, Maybe a)
f1 ForgingStats -> Maybe a -> ForgingStats
f2 = do
  ThreadId
tid <- IO ThreadId -> m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
  let threadStats :: ForgeThreadStats
threadStats   =  ForgeThreadStats -> Maybe ForgeThreadStats -> ForgeThreadStats
forall a. a -> Maybe a -> a
fromMaybe ForgeThreadStats
emptyForgeThreadStats (ThreadId -> Map ThreadId ForgeThreadStats -> Maybe ForgeThreadStats
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ThreadId
tid Map ThreadId ForgeThreadStats
fsStats)
      (ForgeThreadStats
newStats, Maybe a
w) = ForgeThreadStats -> (ForgeThreadStats, Maybe a)
f1 ForgeThreadStats
threadStats
  ForgingStats -> m ForgingStats
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForgingStats -> m ForgingStats) -> ForgingStats -> m ForgingStats
forall a b. (a -> b) -> a -> b
$ ForgingStats -> Maybe a -> ForgingStats
f2 (ForgingStats
fs {fsStats :: Map ThreadId ForgeThreadStats
fsStats = ThreadId
-> ForgeThreadStats
-> Map ThreadId ForgeThreadStats
-> Map ThreadId ForgeThreadStats
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ThreadId
tid ForgeThreadStats
newStats Map ThreadId ForgeThreadStats
fsStats}) Maybe a
w