{-# LANGUAGE UndecidableInstances #-}

-- | Provides types and typeclasses for our environment.
module Shrun.Configuration.Env.Types
  ( -- * \"HasX\" style typeclasses
    HasCommands (..),
    CommandCleanup (..),
    updateCommandStatus,
    getReadCommandStatus,
    HasCommandLogging (..),
    HasCommonLogging (..),
    HasConsoleLogging (..),
    HasFileLogging (..),
    HasTimeout (..),
    setTimedOut,
    whenTimedOut,
    HasInit (..),
    HasAnyError (..),
    setAnyErrorTrue,
    HasNotifyConfig (..),

    -- ** Aggregate
    HasLogging,

    -- * Types
    Env (..),
    whenDebug,
  )
where

import Data.HashMap.Strict qualified as Map
import Shrun.Command.Types
  ( CommandP1,
    CommandStatus,
    CommandStatusMap,
    TCommandStatusMap,
    readCommandStatus,
  )
import Shrun.Configuration.Data.CommandLogging (CommandLoggingEnv)
import Shrun.Configuration.Data.CommonLogging (CommonLoggingEnv)
import Shrun.Configuration.Data.ConfigPhase (ConfigPhase (ConfigPhaseEnv))
import Shrun.Configuration.Data.ConsoleLogging (ConsoleLoggingEnv)
import Shrun.Configuration.Data.Core (CoreConfigP)
import Shrun.Configuration.Data.Core.Timeout (Timeout)
import Shrun.Configuration.Data.FileLogging (FileLoggingEnv)
import Shrun.Configuration.Data.Graph (CommandGraph)
import Shrun.Configuration.Data.Notify (NotificationEnv)
import Shrun.Configuration.Data.WithDisabled (WithDisabled)
import Shrun.Logging.MonadRegionLogger (MonadRegionLogger (Region))
import Shrun.Logging.Types (LogRegion)
import Shrun.Prelude

-- | Alias for all logging config.
type HasLogging env m =
  ( HasCommandLogging env,
    HasCommonLogging env,
    HasConsoleLogging env (Region m),
    HasFileLogging env
  )

-- TODO: When we can (i.e. process provides OsPath API), these types should
-- be changed to OsPath.
data CommandCleanup = MkCommandCleanup
  { CommandCleanup -> FilePath
findPidsExe :: FilePath,
    CommandCleanup -> FilePath
killPidsExe :: FilePath
  }
  deriving stock (CommandCleanup -> CommandCleanup -> Bool
(CommandCleanup -> CommandCleanup -> Bool)
-> (CommandCleanup -> CommandCleanup -> Bool) -> Eq CommandCleanup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandCleanup -> CommandCleanup -> Bool
== :: CommandCleanup -> CommandCleanup -> Bool
$c/= :: CommandCleanup -> CommandCleanup -> Bool
/= :: CommandCleanup -> CommandCleanup -> Bool
Eq, Int -> CommandCleanup -> ShowS
[CommandCleanup] -> ShowS
CommandCleanup -> FilePath
(Int -> CommandCleanup -> ShowS)
-> (CommandCleanup -> FilePath)
-> ([CommandCleanup] -> ShowS)
-> Show CommandCleanup
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandCleanup -> ShowS
showsPrec :: Int -> CommandCleanup -> ShowS
$cshow :: CommandCleanup -> FilePath
show :: CommandCleanup -> FilePath
$cshowList :: [CommandCleanup] -> ShowS
showList :: [CommandCleanup] -> ShowS
Show)

instance
  (k ~ A_Lens, a ~ FilePath, b ~ FilePath) =>
  LabelOptic "findPidsExe" k CommandCleanup CommandCleanup a b
  where
  labelOptic :: Optic k NoIx CommandCleanup CommandCleanup a b
labelOptic =
    LensVL CommandCleanup CommandCleanup a b
-> Lens CommandCleanup CommandCleanup a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL CommandCleanup CommandCleanup a b
 -> Lens CommandCleanup CommandCleanup a b)
-> LensVL CommandCleanup CommandCleanup a b
-> Lens CommandCleanup CommandCleanup a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCommandCleanup FilePath
a1 FilePath
a2) ->
        (FilePath -> CommandCleanup) -> f FilePath -> f CommandCleanup
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\FilePath
b -> FilePath -> FilePath -> CommandCleanup
MkCommandCleanup FilePath
b FilePath
a2)
          (a -> f b
f a
FilePath
a1)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ FilePath, b ~ FilePath) =>
  LabelOptic "killPidsExe" k CommandCleanup CommandCleanup a b
  where
  labelOptic :: Optic k NoIx CommandCleanup CommandCleanup a b
labelOptic =
    LensVL CommandCleanup CommandCleanup a b
-> Lens CommandCleanup CommandCleanup a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL CommandCleanup CommandCleanup a b
 -> Lens CommandCleanup CommandCleanup a b)
-> LensVL CommandCleanup CommandCleanup a b
-> Lens CommandCleanup CommandCleanup a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCommandCleanup FilePath
a1 FilePath
a2) ->
        (FilePath -> CommandCleanup) -> f FilePath -> f CommandCleanup
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\FilePath
b -> FilePath -> FilePath -> CommandCleanup
MkCommandCleanup FilePath
a1 FilePath
b)
          (a -> f b
f a
FilePath
a2)
  {-# INLINE labelOptic #-}

-- | The commands themselves.
class HasCommands env where
  -- | Retrieves the cleanup functions, if they exist.
  getCleanup :: env -> Maybe CommandCleanup

  -- | Retrieves full command graph.
  getCommandDepGraph :: env -> CommandGraph

  -- | Retrieves commands and their statuses.
  getCommandStatusMap :: env -> TCommandStatusMap

-- | Timeout, if any.
class HasTimeout env where
  getTimeout :: env -> WithDisabled Timeout
  getHasTimedOut :: env -> TVar Bool

-- | Init, if any.
class HasInit env where
  getInit :: env -> Maybe Text

class HasCommandLogging env where
  getCommandLogging :: env -> CommandLoggingEnv

class HasCommonLogging env where
  getCommonLogging :: env -> CommonLoggingEnv

class HasConsoleLogging env r where
  getConsoleLogging ::
    env ->
    Tuple3
      -- Console logging config
      ConsoleLoggingEnv
      -- Console log region queue
      (TBQueue (LogRegion r))
      -- Console timer region
      (IORef (Maybe r))

class HasFileLogging env where
  getFileLogging :: env -> Maybe FileLoggingEnv

class HasAnyError env where
  -- | Retrieves the anyError flag.
  getAnyError :: env -> TVar Bool

-- | The main 'Env' type used by Shrun.
data Env notifyEnv logRegion = MkEnv
  { -- | Holds the anyError flag, signaling if any command exited with an
    -- error.
    forall notifyEnv logRegion. Env notifyEnv logRegion -> TVar Bool
anyError :: TVar Bool,
    -- | Functions to clean up running commands.
    forall notifyEnv logRegion.
Env notifyEnv logRegion -> Maybe CommandCleanup
commandCleanup :: Maybe CommandCleanup,
    -- | Holds notification environment.
    -- | Commands
    forall notifyEnv logRegion.
Env notifyEnv logRegion -> NESeq CommandP1
commands :: NESeq CommandP1,
    -- | Command graph.
    forall notifyEnv logRegion. Env notifyEnv logRegion -> CommandGraph
commandGraph :: CommandGraph,
    -- | Map from CommandIndex to Command and its status. Used for determining
    -- e.g. which commands have completed / failed / not run.
    --
    -- The statuses are TVars since they are mutable, though the map itself
    -- can be pure since its structure is fixed at initialization. In fact,
    -- we could probably swap TVar for IORef since we only update the
    -- status from a single thread (each command has its own thread).
    forall notifyEnv logRegion.
Env notifyEnv logRegion -> TCommandStatusMap
commandStatusMap :: TCommandStatusMap,
    -- | Core config.
    forall notifyEnv logRegion.
Env notifyEnv logRegion -> CoreConfigP 'ConfigPhaseEnv notifyEnv
config :: CoreConfigP ConfigPhaseEnv notifyEnv,
    -- | Console log queue.
    forall notifyEnv logRegion.
Env notifyEnv logRegion -> TBQueue (LogRegion logRegion)
consoleLogQueue :: ~(TBQueue (LogRegion logRegion)),
    -- Flag for if shrun has timed out, for conditionally running cleanup.
    forall notifyEnv logRegion. Env notifyEnv logRegion -> TVar Bool
hasTimedOut :: TVar Bool,
    -- | Timer region. It's an IORef only because it is not initialized on
    -- startup. Once it is set it is no longer mutated.
    forall notifyEnv logRegion.
Env notifyEnv logRegion -> IORef (Maybe logRegion)
timerRegion :: IORef (Maybe logRegion)
  }

instance
  ( k ~ A_Lens,
    a ~ TVar Bool,
    b ~ TVar Bool
  ) =>
  LabelOptic "anyError" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (TVar Bool -> Env m r) -> f (TVar Bool) -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\TVar Bool
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
b Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9)
          (a -> f b
f a
TVar Bool
a1)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ Maybe CommandCleanup,
    b ~ Maybe CommandCleanup
  ) =>
  LabelOptic "commandCleanup" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (Maybe CommandCleanup -> Env m r)
-> f (Maybe CommandCleanup) -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\Maybe CommandCleanup
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
b NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9)
          (a -> f b
f a
Maybe CommandCleanup
a2)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ NESeq CommandP1,
    b ~ NESeq CommandP1
  ) =>
  LabelOptic "commands" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (NESeq CommandP1 -> Env m r) -> f (NESeq CommandP1) -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\NESeq CommandP1
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
b CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9)
          (a -> f b
f a
NESeq CommandP1
a3)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ CommandGraph,
    b ~ CommandGraph
  ) =>
  LabelOptic "commandGraph" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (CommandGraph -> Env m r) -> f CommandGraph -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\CommandGraph
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
b TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9)
          (a -> f b
f a
CommandGraph
a4)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ TCommandStatusMap,
    b ~ TCommandStatusMap
  ) =>
  LabelOptic "commandStatusMap" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (TCommandStatusMap -> Env m r)
-> f TCommandStatusMap -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\TCommandStatusMap
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
b CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9)
          (a -> f b
f a
TCommandStatusMap
a5)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ CoreConfigP ConfigPhaseEnv notifyEnv,
    b ~ CoreConfigP ConfigPhaseEnv notifyEnv
  ) =>
  LabelOptic "config" k (Env notifyEnv r) (Env notifyEnv r) a b
  where
  labelOptic :: Optic k NoIx (Env notifyEnv r) (Env notifyEnv r) a b
labelOptic =
    LensVL (Env notifyEnv r) (Env notifyEnv r) a b
-> Lens (Env notifyEnv r) (Env notifyEnv r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env notifyEnv r) (Env notifyEnv r) a b
 -> Lens (Env notifyEnv r) (Env notifyEnv r) a b)
-> LensVL (Env notifyEnv r) (Env notifyEnv r) a b
-> Lens (Env notifyEnv r) (Env notifyEnv r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv notifyEnv
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (CoreConfigP 'ConfigPhaseEnv notifyEnv -> Env notifyEnv r)
-> f (CoreConfigP 'ConfigPhaseEnv notifyEnv) -> f (Env notifyEnv r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\CoreConfigP 'ConfigPhaseEnv notifyEnv
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env notifyEnv r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv notifyEnv
b TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9)
          (a -> f b
f a
CoreConfigP 'ConfigPhaseEnv notifyEnv
a6)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ TBQueue (LogRegion r),
    b ~ TBQueue (LogRegion r)
  ) =>
  LabelOptic "consoleLogQueue" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (TBQueue (LogRegion r) -> Env m r)
-> f (TBQueue (LogRegion r)) -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\TBQueue (LogRegion r)
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
b TVar Bool
a8 IORef (Maybe r)
a9)
          (a -> f b
f a
TBQueue (LogRegion r)
a7)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ TVar Bool,
    b ~ TVar Bool
  ) =>
  LabelOptic "hasTimedOut" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (TVar Bool -> Env m r) -> f (TVar Bool) -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\TVar Bool
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
b IORef (Maybe r)
a9)
          (a -> f b
f a
TVar Bool
a8)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ IORef (Maybe r),
    b ~ IORef (Maybe r)
  ) =>
  LabelOptic "timerRegion" k (Env m r) (Env m r) a b
  where
  labelOptic :: Optic k NoIx (Env m r) (Env m r) a b
labelOptic =
    LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b)
-> LensVL (Env m r) (Env m r) a b -> Lens (Env m r) (Env m r) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
a9) ->
        (IORef (Maybe r) -> Env m r) -> f (IORef (Maybe r)) -> f (Env m r)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\IORef (Maybe r)
b -> TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv m
-> TBQueue (LogRegion r)
-> TVar Bool
-> IORef (Maybe r)
-> Env m r
forall notifyEnv logRegion.
TVar Bool
-> Maybe CommandCleanup
-> NESeq CommandP1
-> CommandGraph
-> TCommandStatusMap
-> CoreConfigP 'ConfigPhaseEnv notifyEnv
-> TBQueue (LogRegion logRegion)
-> TVar Bool
-> IORef (Maybe logRegion)
-> Env notifyEnv logRegion
MkEnv TVar Bool
a1 Maybe CommandCleanup
a2 NESeq CommandP1
a3 CommandGraph
a4 TCommandStatusMap
a5 CoreConfigP 'ConfigPhaseEnv m
a6 TBQueue (LogRegion r)
a7 TVar Bool
a8 IORef (Maybe r)
b)
          (a -> f b
f a
IORef (Maybe r)
a9)
  {-# INLINE labelOptic #-}

instance HasTimeout (Env m r) where
  getTimeout :: Env m r -> WithDisabled Timeout
getTimeout = Optic' A_Lens NoIx (Env m r) (WithDisabled Timeout)
-> Env m r -> WithDisabled Timeout
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
#config Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
-> Optic
     A_Lens
     NoIx
     (CoreConfigP 'ConfigPhaseEnv m)
     (CoreConfigP 'ConfigPhaseEnv m)
     (WithDisabled Timeout)
     (WithDisabled Timeout)
-> Optic' A_Lens NoIx (Env m r) (WithDisabled Timeout)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
  (WithDisabled Timeout)
  (WithDisabled Timeout)
#timeout)

  getHasTimedOut :: Env m r -> TVar Bool
getHasTimedOut = Optic' A_Lens NoIx (Env m r) (TVar Bool) -> Env m r -> TVar Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (Env m r) (TVar Bool)
#hasTimedOut

instance HasInit (Env m r) where
  getInit :: Env m r -> Maybe Text
getInit = Optic' A_Lens NoIx (Env m r) (Maybe Text) -> Env m r -> Maybe Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
#config Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
-> Optic
     A_Lens
     NoIx
     (CoreConfigP 'ConfigPhaseEnv m)
     (CoreConfigP 'ConfigPhaseEnv m)
     (Maybe Text)
     (Maybe Text)
-> Optic' A_Lens NoIx (Env m r) (Maybe Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
  (Maybe Text)
  (Maybe Text)
#init)

instance HasCommandLogging (Env m r) where
  getCommandLogging :: Env m r -> CommandLoggingEnv
getCommandLogging = Optic' A_Lens NoIx (Env m r) CommandLoggingEnv
-> Env m r -> CommandLoggingEnv
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
#config Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
-> Optic
     A_Lens
     NoIx
     (CoreConfigP 'ConfigPhaseEnv m)
     (CoreConfigP 'ConfigPhaseEnv m)
     CommandLoggingEnv
     CommandLoggingEnv
-> Optic' A_Lens NoIx (Env m r) CommandLoggingEnv
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
  CommandLoggingEnv
  CommandLoggingEnv
#commandLogging)

instance HasCommonLogging (Env m r) where
  getCommonLogging :: Env m r -> CommonLoggingEnv
getCommonLogging = Optic' A_Lens NoIx (Env m r) CommonLoggingEnv
-> Env m r -> CommonLoggingEnv
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
#config Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
-> Optic
     A_Lens
     NoIx
     (CoreConfigP 'ConfigPhaseEnv m)
     (CoreConfigP 'ConfigPhaseEnv m)
     CommonLoggingEnv
     CommonLoggingEnv
-> Optic' A_Lens NoIx (Env m r) CommonLoggingEnv
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
  CommonLoggingEnv
  CommonLoggingEnv
#commonLogging)

instance HasConsoleLogging (Env m r) r where
  getConsoleLogging :: Env m r
-> (ConsoleLoggingEnv, TBQueue (LogRegion r), IORef (Maybe r))
getConsoleLogging Env m r
env =
    ( Env m r
env Env m r
-> Optic' A_Lens NoIx (Env m r) ConsoleLoggingEnv
-> ConsoleLoggingEnv
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
#config Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
-> Optic
     A_Lens
     NoIx
     (CoreConfigP 'ConfigPhaseEnv m)
     (CoreConfigP 'ConfigPhaseEnv m)
     ConsoleLoggingEnv
     ConsoleLoggingEnv
-> Optic' A_Lens NoIx (Env m r) ConsoleLoggingEnv
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
  ConsoleLoggingEnv
  ConsoleLoggingEnv
#consoleLogging,
      Env m r
env Env m r
-> Optic' A_Lens NoIx (Env m r) (TBQueue (LogRegion r))
-> TBQueue (LogRegion r)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Env m r) (TBQueue (LogRegion r))
#consoleLogQueue,
      Env m r
env Env m r
-> Optic' A_Lens NoIx (Env m r) (IORef (Maybe r))
-> IORef (Maybe r)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Env m r) (IORef (Maybe r))
#timerRegion
    )

instance HasFileLogging (Env m r) where
  getFileLogging :: Env m r -> Maybe FileLoggingEnv
getFileLogging = Optic' A_Lens NoIx (Env m r) (Maybe FileLoggingEnv)
-> Env m r -> Maybe FileLoggingEnv
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
#config Optic
  A_Lens
  NoIx
  (Env m r)
  (Env m r)
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
-> Optic
     A_Lens
     NoIx
     (CoreConfigP 'ConfigPhaseEnv m)
     (CoreConfigP 'ConfigPhaseEnv m)
     (Maybe FileLoggingEnv)
     (Maybe FileLoggingEnv)
-> Optic' A_Lens NoIx (Env m r) (Maybe FileLoggingEnv)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigP 'ConfigPhaseEnv m)
  (CoreConfigP 'ConfigPhaseEnv m)
  (Maybe FileLoggingEnv)
  (Maybe FileLoggingEnv)
#fileLogging)

instance HasCommands (Env m r) where
  getCleanup :: Env m r -> Maybe CommandCleanup
getCleanup = Optic' A_Lens NoIx (Env m r) (Maybe CommandCleanup)
-> Env m r -> Maybe CommandCleanup
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (Env m r) (Maybe CommandCleanup)
#commandCleanup

  getCommandDepGraph :: Env m r -> CommandGraph
getCommandDepGraph = Optic' A_Lens NoIx (Env m r) CommandGraph
-> Env m r -> CommandGraph
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (Env m r) CommandGraph
#commandGraph

  getCommandStatusMap :: Env m r -> TCommandStatusMap
getCommandStatusMap = Optic' A_Lens NoIx (Env m r) TCommandStatusMap
-> Env m r -> TCommandStatusMap
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (Env m r) TCommandStatusMap
#commandStatusMap

-- | Prepends a completed command.
updateCommandStatus ::
  ( HasCallStack,
    HasCommands env,
    MonadAtomic m,
    MonadReader env m,
    MonadThrow m
  ) =>
  CommandP1 ->
  CommandStatus ->
  m ()
updateCommandStatus :: forall env (m :: Type -> Type).
(HasCallStack, HasCommands env, MonadAtomic m, MonadReader env m,
 MonadThrow m) =>
CommandP1 -> CommandStatus -> m ()
updateCommandStatus CommandP1
command CommandStatus
result = do
  HashMap CommandIndex (CommandP1, TVar CommandStatus)
commandStatusMap <- (env -> TCommandStatusMap) -> m TCommandStatusMap
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> TCommandStatusMap
forall env. HasCommands env => env -> TCommandStatusMap
getCommandStatusMap m TCommandStatusMap
-> (TCommandStatusMap
    -> HashMap CommandIndex (CommandP1, TVar CommandStatus))
-> m (HashMap CommandIndex (CommandP1, TVar CommandStatus))
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Optic'
  An_Iso
  NoIx
  TCommandStatusMap
  (HashMap CommandIndex (CommandP1, TVar CommandStatus))
-> TCommandStatusMap
-> HashMap CommandIndex (CommandP1, TVar CommandStatus)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic'
  An_Iso
  NoIx
  TCommandStatusMap
  (HashMap CommandIndex (CommandP1, TVar CommandStatus))
#unCommandStatusMap
  case CommandIndex
-> HashMap CommandIndex (CommandP1, TVar CommandStatus)
-> Maybe (CommandP1, TVar CommandStatus)
forall k v. Hashable k => k -> HashMap k v -> Maybe v
Map.lookup CommandIndex
idx HashMap CommandIndex (CommandP1, TVar CommandStatus)
commandStatusMap of
    Maybe (CommandP1, TVar CommandStatus)
Nothing -> Text -> m ()
forall (m :: Type -> Type) a.
(HasCallStack, MonadThrow m) =>
Text -> m a
throwText (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ CommandIndex -> Text
forall a. Pretty a => a -> Text
prettyToText CommandIndex
idx
    Just (CommandP1
_, TVar CommandStatus
statusVar) -> TVar CommandStatus -> CommandStatus -> m ()
forall (m :: Type -> Type) a.
(HasCallStack, MonadAtomic m) =>
TVar a -> a -> m ()
writeTVarA' TVar CommandStatus
statusVar CommandStatus
result
  where
    idx :: CommandIndex
idx = CommandP1
command CommandP1
-> Optic' A_Lens NoIx CommandP1 CommandIndex -> CommandIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommandP1 CommandIndex
#index
{-# INLINEABLE updateCommandStatus #-}

instance HasAnyError (Env m r) where
  getAnyError :: Env m r -> TVar Bool
getAnyError = Optic' A_Lens NoIx (Env m r) (TVar Bool) -> Env m r -> TVar Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (Env m r) (TVar Bool)
#anyError

-- | Set anyError to 'True'.
setAnyErrorTrue ::
  ( HasAnyError env,
    HasCallStack,
    MonadAtomic m,
    MonadReader env m
  ) =>
  m ()
setAnyErrorTrue :: forall env (m :: Type -> Type).
(HasAnyError env, HasCallStack, MonadAtomic m,
 MonadReader env m) =>
m ()
setAnyErrorTrue = (env -> TVar Bool) -> m (TVar Bool)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> TVar Bool
forall env. HasAnyError env => env -> TVar Bool
getAnyError m (TVar Bool) -> (TVar Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TVar Bool
ref -> TVar Bool -> Bool -> m ()
forall (m :: Type -> Type) a.
(HasCallStack, MonadAtomic m) =>
TVar a -> a -> m ()
writeTVarA' TVar Bool
ref Bool
True
{-# INLINEABLE setAnyErrorTrue #-}

-- | Class for retrieving the notify config.
class HasNotifyConfig env r where
  -- | Retrieves the notify config.
  getNotifyConfig :: env -> Maybe (NotificationEnv r)

instance HasNotifyConfig (Env notifyEnv r) notifyEnv where
  getNotifyConfig :: Env notifyEnv r -> Maybe (NotificationEnv notifyEnv)
getNotifyConfig = Optic'
  A_Lens NoIx (Env notifyEnv r) (Maybe (NotificationEnv notifyEnv))
-> Env notifyEnv r -> Maybe (NotificationEnv notifyEnv)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  (Env notifyEnv r)
  (Env notifyEnv r)
  (CoreConfigP 'ConfigPhaseEnv notifyEnv)
  (CoreConfigP 'ConfigPhaseEnv notifyEnv)
#config Optic
  A_Lens
  NoIx
  (Env notifyEnv r)
  (Env notifyEnv r)
  (CoreConfigP 'ConfigPhaseEnv notifyEnv)
  (CoreConfigP 'ConfigPhaseEnv notifyEnv)
-> Optic
     A_Lens
     NoIx
     (CoreConfigP 'ConfigPhaseEnv notifyEnv)
     (CoreConfigP 'ConfigPhaseEnv notifyEnv)
     (Maybe (NotificationEnv notifyEnv))
     (Maybe (NotificationEnv notifyEnv))
-> Optic'
     A_Lens NoIx (Env notifyEnv r) (Maybe (NotificationEnv notifyEnv))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigP 'ConfigPhaseEnv notifyEnv)
  (CoreConfigP 'ConfigPhaseEnv notifyEnv)
  (Maybe (NotificationEnv notifyEnv))
  (Maybe (NotificationEnv notifyEnv))
#notifications)

-- | Run the action when the debug flag is active.
whenDebug :: (HasCommonLogging env, MonadReader env m) => m () -> m ()
whenDebug :: forall env (m :: Type -> Type).
(HasCommonLogging env, MonadReader env m) =>
m () -> m ()
whenDebug m ()
m = do
  Bool
debug <- (env -> Bool) -> m Bool
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx CommonLoggingEnv Bool
-> CommonLoggingEnv -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens NoIx CommonLoggingEnv CommonLoggingEnv Debug Debug
#debug Optic A_Lens NoIx CommonLoggingEnv CommonLoggingEnv Debug Debug
-> Optic An_Iso NoIx Debug Debug Bool Bool
-> Optic' A_Lens NoIx CommonLoggingEnv Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx Debug Debug Bool Bool
#unDebug) (CommonLoggingEnv -> Bool)
-> (env -> CommonLoggingEnv) -> env -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. env -> CommonLoggingEnv
forall env. HasCommonLogging env => env -> CommonLoggingEnv
getCommonLogging)
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
debug m ()
m

-- | Retrieves the entire status map in a single STM transaction.
getReadCommandStatus ::
  ( HasCallStack,
    HasCommands env,
    MonadAtomic m,
    MonadReader env m
  ) =>
  m CommandStatusMap
getReadCommandStatus :: forall env (m :: Type -> Type).
(HasCallStack, HasCommands env, MonadAtomic m,
 MonadReader env m) =>
m CommandStatusMap
getReadCommandStatus = (env -> TCommandStatusMap) -> m TCommandStatusMap
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> TCommandStatusMap
forall env. HasCommands env => env -> TCommandStatusMap
getCommandStatusMap m TCommandStatusMap
-> (TCommandStatusMap -> m CommandStatusMap) -> m CommandStatusMap
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= TCommandStatusMap -> m CommandStatusMap
forall (m :: Type -> Type).
(HasCallStack, MonadAtomic m) =>
TCommandStatusMap -> m CommandStatusMap
readCommandStatus

-- | Sets timedout to true.
setTimedOut :: (HasTimeout env, MonadAtomic m, MonadReader env m) => m ()
setTimedOut :: forall env (m :: Type -> Type).
(HasTimeout env, MonadAtomic m, MonadReader env m) =>
m ()
setTimedOut = (env -> TVar Bool) -> m (TVar Bool)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> TVar Bool
forall env. HasTimeout env => env -> TVar Bool
getHasTimedOut m (TVar Bool) -> (TVar Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TVar Bool
r -> TVar Bool -> Bool -> m ()
forall (m :: Type -> Type) a.
(HasCallStack, MonadAtomic m) =>
TVar a -> a -> m ()
writeTVarA' TVar Bool
r Bool
True

-- | Run the action when shrun has timed out.
whenTimedOut :: (HasTimeout env, MonadAtomic m, MonadReader env m) => m () -> m ()
whenTimedOut :: forall env (m :: Type -> Type).
(HasTimeout env, MonadAtomic m, MonadReader env m) =>
m () -> m ()
whenTimedOut m ()
m = do
  Bool
hasTimedOut <- TVar Bool -> m Bool
forall (m :: Type -> Type) a.
(HasCallStack, MonadAtomic m) =>
TVar a -> m a
readTVarA' (TVar Bool -> m Bool) -> m (TVar Bool) -> m Bool
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (env -> TVar Bool) -> m (TVar Bool)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> TVar Bool
forall env. HasTimeout env => env -> TVar Bool
getHasTimedOut
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
hasTimedOut m ()
m