{-| Timing of Plinth compilation stages through GHC's own timing infrastructure.

Each stage is wrapped in 'GHC.Utils.Error.withTiming', so it is reported alongside GHC's
own phases under @-ddump-timings@ (or @-v2@) and emits begin/end events to the eventlog. -}
module PlutusTx.Plugin.Timing (timeStage, timingsEnabled) where

import Control.Monad.IO.Class (MonadIO)
import GHC.Driver.Flags (DumpFlag (Opt_D_dump_timings))
import GHC.Utils.Error (withTiming)
import GHC.Utils.Logger (Logger, logHasDumpFlag, logVerbAtLeast)
import GHC.Utils.Outputable (brackets, text, (<+>))

{-| Time an action as the phase @Plinth \<stage\> [\<scope\>]@.

When timings are off this is just the action. When they are on, the result is
evaluated to WHNF and, if forcing is requested, further with the given function
before the clocks stop. -}
timeStage
  :: MonadIO monad
  => Logger
  -> Bool
  -- ^ Whether to force the result with the given function.
  -> String
  -- ^ Module or expression scope.
  -> String
  -- ^ Stage name.
  -> (result -> ())
  -- ^ Forces the result; only called when timings are on and forcing is requested.
  -> monad result
  -- ^ Action to measure.
  -> monad result
timeStage :: forall (monad :: * -> *) result.
MonadIO monad =>
Logger
-> Bool
-> String
-> String
-> (result -> ())
-> monad result
-> monad result
timeStage Logger
logger Bool
forceResults String
scope String
stage result -> ()
forceResult =
  Logger -> SDoc -> (result -> ()) -> monad result -> monad result
forall (m :: * -> *) a.
MonadIO m =>
Logger -> SDoc -> (a -> ()) -> m a -> m a
withTiming
    Logger
logger
    (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Plinth" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
stage SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
scope))
    (if Bool
forceResults then result -> ()
forceResult else () -> result -> ()
forall a b. a -> b -> a
const ())

-- | Whether GHC will report timings: the same condition 'withTiming' checks.
timingsEnabled :: Logger -> Bool
timingsEnabled :: Logger -> Bool
timingsEnabled Logger
logger = Logger -> Int -> Bool
logVerbAtLeast Logger
logger Int
2 Bool -> Bool -> Bool
|| Logger -> DumpFlag -> Bool
logHasDumpFlag Logger
logger DumpFlag
Opt_D_dump_timings