-- | Provides functionality for logging to a specific region
-- (i.e. for concurrent console logging).
module Shrun.Logging.MonadRegionLogger
  ( MonadRegionLogger (..),
  )
where

import Shrun.Logging.Types.Internal
  ( LogMode
      ( LogModeAppend,
        LogModeFinish,
        LogModeSet
      ),
  )
import Shrun.Prelude
import System.Console.Regions qualified as Regions

-- | `MonadRegionLogger` is a simple typeclass for abstracting logging functions.
type MonadRegionLogger :: (Type -> Type) -> Constraint
class (Monad m) => MonadRegionLogger m where
  -- | The type of the region. This will be ConsoleRegion for production
  -- code and () for tests.
  type Region m

  -- | Pushes a log to the "global" region.
  logGlobal :: (HasCallStack) => Text -> m ()

  -- | Pushes a log to the region.
  logRegion :: (HasCallStack) => LogMode -> Region m -> Text -> m ()

  -- | Runs an @m a@ with a region.
  withRegion :: (HasCallStack) => RegionLayout -> (Region m -> m a) -> m a

  -- | Displays the regions. This should wrap whatever top-level logic
  -- needs regions.
  displayRegions :: (HasCallStack) => m a -> m a

instance MonadRegionLogger IO where
  type Region IO = ConsoleRegion

  logGlobal :: HasCallStack => Text -> IO ()
logGlobal = Text -> IO ()
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn
  {-# INLINEABLE logGlobal #-}

  logRegion :: HasCallStack => LogMode -> Region IO -> Text -> IO ()
logRegion LogMode
LogModeSet Region IO
cr = ConsoleRegion -> Text -> IO ()
forall v (m :: Type -> Type).
(ToRegionContent v, LiftRegion m) =>
ConsoleRegion -> v -> m ()
Regions.setConsoleRegion ConsoleRegion
Region IO
cr
  logRegion LogMode
LogModeAppend Region IO
cr = ConsoleRegion -> Text -> IO ()
forall v (m :: Type -> Type).
(Outputable v, LiftRegion m) =>
ConsoleRegion -> v -> m ()
Regions.appendConsoleRegion ConsoleRegion
Region IO
cr
  logRegion LogMode
LogModeFinish Region IO
cr = ConsoleRegion -> Text -> IO ()
forall v (m :: Type -> Type).
(Outputable v, LiftRegion m) =>
ConsoleRegion -> v -> m ()
Regions.finishConsoleRegion ConsoleRegion
Region IO
cr
  {-# INLINEABLE logRegion #-}

  withRegion :: forall a.
HasCallStack =>
RegionLayout -> (Region IO -> IO a) -> IO a
withRegion = RegionLayout -> (ConsoleRegion -> IO a) -> IO a
RegionLayout -> (Region IO -> IO a) -> IO a
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
RegionLayout -> (ConsoleRegion -> m a) -> m a
Regions.withConsoleRegion
  {-# INLINEABLE withRegion #-}

  displayRegions :: forall a. HasCallStack => IO a -> IO a
displayRegions = IO a -> IO a
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
m a -> m a
Regions.displayConsoleRegions
  {-# INLINEABLE displayRegions #-}

instance (MonadRegionLogger m) => MonadRegionLogger (ReaderT env m) where
  type Region (ReaderT env m) = Region m

  logGlobal :: HasCallStack => Text -> ReaderT env m ()
logGlobal = m () -> ReaderT env m ()
forall (m :: Type -> Type) a. Monad m => m a -> ReaderT env m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (Text -> m ()) -> Text -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: Type -> Type).
(MonadRegionLogger m, HasCallStack) =>
Text -> m ()
logGlobal
  {-# INLINEABLE logGlobal #-}

  logRegion :: HasCallStack =>
LogMode -> Region (ReaderT env m) -> Text -> ReaderT env m ()
logRegion LogMode
m Region (ReaderT env m)
r = m () -> ReaderT env m ()
forall (m :: Type -> Type) a. Monad m => m a -> ReaderT env m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (Text -> m ()) -> Text -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMode -> Region m -> Text -> m ()
forall (m :: Type -> Type).
(MonadRegionLogger m, HasCallStack) =>
LogMode -> Region m -> Text -> m ()
logRegion LogMode
m Region m
Region (ReaderT env m)
r
  {-# INLINEABLE logRegion #-}

  withRegion :: forall a.
HasCallStack =>
RegionLayout
-> (Region (ReaderT env m) -> ReaderT env m a) -> ReaderT env m a
withRegion RegionLayout
l Region (ReaderT env m) -> ReaderT env m a
f =
    ReaderT env m env
forall r (m :: Type -> Type). MonadReader r m => m r
ask ReaderT env m env -> (env -> ReaderT env m a) -> ReaderT env m a
forall a b.
ReaderT env m a -> (a -> ReaderT env m b) -> ReaderT env m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \env
e -> m a -> ReaderT env m a
forall (m :: Type -> Type) a. Monad m => m a -> ReaderT env m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RegionLayout -> (Region m -> m a) -> m a
forall a. HasCallStack => RegionLayout -> (Region m -> m a) -> m a
forall (m :: Type -> Type) a.
(MonadRegionLogger m, HasCallStack) =>
RegionLayout -> (Region m -> m a) -> m a
withRegion RegionLayout
l (\Region m
r -> ReaderT env m a -> env -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (Region (ReaderT env m) -> ReaderT env m a
f Region m
Region (ReaderT env m)
r) env
e))
  {-# INLINEABLE withRegion #-}

  displayRegions :: forall a. HasCallStack => ReaderT env m a -> ReaderT env m a
displayRegions ReaderT env m a
m = ReaderT env m env
forall r (m :: Type -> Type). MonadReader r m => m r
ask ReaderT env m env -> (env -> ReaderT env m a) -> ReaderT env m a
forall a b.
ReaderT env m a -> (a -> ReaderT env m b) -> ReaderT env m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \env
e -> m a -> ReaderT env m a
forall (m :: Type -> Type) a. Monad m => m a -> ReaderT env m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> m a
forall a. HasCallStack => m a -> m a
forall (m :: Type -> Type) a.
(MonadRegionLogger m, HasCallStack) =>
m a -> m a
displayRegions (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ ReaderT env m a -> env -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT ReaderT env m a
m env
e)
  {-# INLINEABLE displayRegions #-}