{-# LANGUAGE PatternSynonyms #-}

-- | Utility functions for enclosing a code segment with tracing events.
module Ouroboros.Consensus.Util.Enclose (
    Enclosing
  , Enclosing' (..)
  , EnclosingTimed
  , encloseTimedWith
  , encloseWith
  , pattern FallingEdge
  ) where

import           Control.Monad.Class.MonadTime.SI (DiffTime,
                     MonadMonotonicTime (..), diffTime)
import           Control.Tracer (Tracer, traceWith)

data Enclosing' a =
    -- | Preceding a specific code segment.
    RisingEdge
    -- | Succeeding a specific code segment, with extra information.
  | FallingEdgeWith !a
  deriving (Int -> Enclosing' a -> ShowS
[Enclosing' a] -> ShowS
Enclosing' a -> String
(Int -> Enclosing' a -> ShowS)
-> (Enclosing' a -> String)
-> ([Enclosing' a] -> ShowS)
-> Show (Enclosing' a)
forall a. Show a => Int -> Enclosing' a -> ShowS
forall a. Show a => [Enclosing' a] -> ShowS
forall a. Show a => Enclosing' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Enclosing' a -> ShowS
showsPrec :: Int -> Enclosing' a -> ShowS
$cshow :: forall a. Show a => Enclosing' a -> String
show :: Enclosing' a -> String
$cshowList :: forall a. Show a => [Enclosing' a] -> ShowS
showList :: [Enclosing' a] -> ShowS
Show, Enclosing' a -> Enclosing' a -> Bool
(Enclosing' a -> Enclosing' a -> Bool)
-> (Enclosing' a -> Enclosing' a -> Bool) -> Eq (Enclosing' a)
forall a. Eq a => Enclosing' a -> Enclosing' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Enclosing' a -> Enclosing' a -> Bool
== :: Enclosing' a -> Enclosing' a -> Bool
$c/= :: forall a. Eq a => Enclosing' a -> Enclosing' a -> Bool
/= :: Enclosing' a -> Enclosing' a -> Bool
Eq, Eq (Enclosing' a)
Eq (Enclosing' a) =>
(Enclosing' a -> Enclosing' a -> Ordering)
-> (Enclosing' a -> Enclosing' a -> Bool)
-> (Enclosing' a -> Enclosing' a -> Bool)
-> (Enclosing' a -> Enclosing' a -> Bool)
-> (Enclosing' a -> Enclosing' a -> Bool)
-> (Enclosing' a -> Enclosing' a -> Enclosing' a)
-> (Enclosing' a -> Enclosing' a -> Enclosing' a)
-> Ord (Enclosing' a)
Enclosing' a -> Enclosing' a -> Bool
Enclosing' a -> Enclosing' a -> Ordering
Enclosing' a -> Enclosing' a -> Enclosing' a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Enclosing' a)
forall a. Ord a => Enclosing' a -> Enclosing' a -> Bool
forall a. Ord a => Enclosing' a -> Enclosing' a -> Ordering
forall a. Ord a => Enclosing' a -> Enclosing' a -> Enclosing' a
$ccompare :: forall a. Ord a => Enclosing' a -> Enclosing' a -> Ordering
compare :: Enclosing' a -> Enclosing' a -> Ordering
$c< :: forall a. Ord a => Enclosing' a -> Enclosing' a -> Bool
< :: Enclosing' a -> Enclosing' a -> Bool
$c<= :: forall a. Ord a => Enclosing' a -> Enclosing' a -> Bool
<= :: Enclosing' a -> Enclosing' a -> Bool
$c> :: forall a. Ord a => Enclosing' a -> Enclosing' a -> Bool
> :: Enclosing' a -> Enclosing' a -> Bool
$c>= :: forall a. Ord a => Enclosing' a -> Enclosing' a -> Bool
>= :: Enclosing' a -> Enclosing' a -> Bool
$cmax :: forall a. Ord a => Enclosing' a -> Enclosing' a -> Enclosing' a
max :: Enclosing' a -> Enclosing' a -> Enclosing' a
$cmin :: forall a. Ord a => Enclosing' a -> Enclosing' a -> Enclosing' a
min :: Enclosing' a -> Enclosing' a -> Enclosing' a
Ord)

type Enclosing = Enclosing' ()

pattern FallingEdge :: Enclosing' ()
pattern $mFallingEdge :: forall {r}. Enclosing' () -> ((# #) -> r) -> ((# #) -> r) -> r
$bFallingEdge :: Enclosing' ()
FallingEdge = FallingEdgeWith ()

{-# COMPLETE RisingEdge, FallingEdge #-}

-- | Enclose an action using the given 'Tracer'.
encloseWith ::
     Applicative m
  => Tracer m Enclosing
  -> m a
  -> m a
encloseWith :: forall (m :: * -> *) a.
Applicative m =>
Tracer m (Enclosing' ()) -> m a -> m a
encloseWith Tracer m (Enclosing' ())
tracer m a
action =
    Tracer m (Enclosing' ()) -> Enclosing' () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Enclosing' ())
tracer Enclosing' ()
forall a. Enclosing' a
RisingEdge m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
action m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tracer m (Enclosing' ()) -> Enclosing' () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Enclosing' ())
tracer Enclosing' ()
FallingEdge

type EnclosingTimed = Enclosing' DiffTime

encloseTimedWith ::
     MonadMonotonicTime m
  => Tracer m EnclosingTimed
  -> m a
  -> m a
encloseTimedWith :: forall (m :: * -> *) a.
MonadMonotonicTime m =>
Tracer m EnclosingTimed -> m a -> m a
encloseTimedWith Tracer m EnclosingTimed
tracer m a
action = do
    Time
before <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
    Tracer m EnclosingTimed -> EnclosingTimed -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m EnclosingTimed
tracer EnclosingTimed
forall a. Enclosing' a
RisingEdge
    a
res <- m a
action
    Time
after <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
    Tracer m EnclosingTimed -> EnclosingTimed -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m EnclosingTimed
tracer (DiffTime -> EnclosingTimed
forall a. a -> Enclosing' a
FallingEdgeWith (Time
after Time -> Time -> DiffTime
`diffTime` Time
before))
    a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res