-- | Provides logging functionality. This is a high-level picture of how
-- logging works:
--
-- 1. "Shrun.IO" sends logs per command based on the environment (i.e. is file
--    logging on and/or do we log commands). If any logs are produced, they
--    are formatted and sent directly to a queue.
--
-- 2. "Shrun" also produces logs. These are "higher-level" e.g. success/failure
--    status of a given command, fatal errors, etc. "Shrun" uses the functions
--    here (e.g. putRegionLog) that handles deciding if a given log
--    should be written to either/both of the console/file log queues.
--
-- 3. "Shrun" has two threads -- one for each queue -- that poll their
--    respective queues and writes logs as they are found. These do no
--    environment checking; any logs that make it to the queue are eventually
--    written.
module Shrun.Logging
  ( -- * Writing logs
    putRegionLog,
    regionLogToConsoleQueue,
    logToFileQueue,
  )
where

import Shrun.Configuration.Data.CommonLogging.KeyHideSwitch (KeyHideSwitch)
import Shrun.Configuration.Data.FileLogging (FileLoggingEnv)
import Shrun.Configuration.Env.Types
  ( HasCommonLogging (getCommonLogging),
    HasConsoleLogging (getConsoleLogging),
    HasFileLogging (getFileLogging),
  )
import Shrun.Logging.Formatting (formatConsoleLog, formatFileLog)
import Shrun.Logging.MonadRegionLogger (MonadRegionLogger (Region))
import Shrun.Logging.Types
  ( Log,
    LogRegion (LogRegion),
  )
import Shrun.Prelude

-- | Unconditionally writes a log to the console queue. Conditionally
-- writes the log to the file queue, if 'Logging'\'s @fileLogging@ is
-- present.
putRegionLog ::
  ( HasCallStack,
    HasCommonLogging env,
    HasConsoleLogging env (Region m),
    HasFileLogging env,
    MonadReader env m,
    MonadSTM m,
    MonadTime m
  ) =>
  -- | Region.
  Region m ->
  -- | Log to send.
  Log ->
  m ()
putRegionLog :: forall env (m :: Type -> Type).
(HasCallStack, HasCommonLogging env,
 HasConsoleLogging env (Region m), HasFileLogging env,
 MonadReader env m, MonadSTM m, MonadTime m) =>
Region m -> Log -> m ()
putRegionLog Region m
region Log
lg = do
  CommonLoggingEnv
commonLogging <- (env -> CommonLoggingEnv) -> m CommonLoggingEnv
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> CommonLoggingEnv
forall env. HasCommonLogging env => env -> CommonLoggingEnv
getCommonLogging
  Maybe FileLoggingEnv
mFileLogging <- (env -> Maybe FileLoggingEnv) -> m (Maybe FileLoggingEnv)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> Maybe FileLoggingEnv
forall env. HasFileLogging env => env -> Maybe FileLoggingEnv
getFileLogging

  let keyHide :: KeyHideSwitch
keyHide = CommonLoggingEnv
commonLogging CommonLoggingEnv
-> Optic' An_Iso NoIx CommonLoggingEnv KeyHideSwitch
-> KeyHideSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx CommonLoggingEnv KeyHideSwitch
#keyHide

  Region m -> Log -> m ()
forall env (m :: Type -> Type).
(HasCallStack, HasCommonLogging env,
 HasConsoleLogging env (Region m), MonadReader env m, MonadSTM m) =>
Region m -> Log -> m ()
regionLogToConsoleQueue Region m
region Log
lg
  Maybe FileLoggingEnv -> (FileLoggingEnv -> m ()) -> m ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe FileLoggingEnv
mFileLogging (\FileLoggingEnv
fl -> KeyHideSwitch -> FileLoggingEnv -> Log -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadSTM m, MonadTime m) =>
KeyHideSwitch -> FileLoggingEnv -> Log -> m ()
logToFileQueue KeyHideSwitch
keyHide FileLoggingEnv
fl Log
lg)

-- | Writes the log to the console queue.
regionLogToConsoleQueue ::
  ( HasCallStack,
    HasCommonLogging env,
    HasConsoleLogging env (Region m),
    MonadReader env m,
    MonadSTM m
  ) =>
  -- | Region.
  Region m ->
  -- | Log to send.
  Log ->
  m ()
regionLogToConsoleQueue :: forall env (m :: Type -> Type).
(HasCallStack, HasCommonLogging env,
 HasConsoleLogging env (Region m), MonadReader env m, MonadSTM m) =>
Region m -> Log -> m ()
regionLogToConsoleQueue Region m
region Log
log = do
  KeyHideSwitch
keyHide <- (env -> KeyHideSwitch) -> m KeyHideSwitch
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks (Optic' An_Iso NoIx CommonLoggingEnv KeyHideSwitch
-> CommonLoggingEnv -> KeyHideSwitch
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx CommonLoggingEnv KeyHideSwitch
#keyHide (CommonLoggingEnv -> KeyHideSwitch)
-> (env -> CommonLoggingEnv) -> env -> KeyHideSwitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> CommonLoggingEnv
forall env. HasCommonLogging env => env -> CommonLoggingEnv
getCommonLogging)
  (ConsoleLoggingEnv
consoleLogging, TBQueue (LogRegion (Region m))
queue) <- (env -> (ConsoleLoggingEnv, TBQueue (LogRegion (Region m))))
-> m (ConsoleLoggingEnv, TBQueue (LogRegion (Region m)))
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks env -> (ConsoleLoggingEnv, TBQueue (LogRegion (Region m)))
forall env r.
HasConsoleLogging env r =>
env -> Tuple2 ConsoleLoggingEnv (TBQueue (LogRegion r))
getConsoleLogging

  let formatted :: ConsoleLog
formatted = KeyHideSwitch -> ConsoleLoggingEnv -> Log -> ConsoleLog
formatConsoleLog KeyHideSwitch
keyHide ConsoleLoggingEnv
consoleLogging Log
log

  TBQueue (LogRegion (Region m)) -> LogRegion (Region m) -> m ()
forall (m :: Type -> Type) a.
(HasCallStack, MonadSTM m) =>
TBQueue a -> a -> m ()
writeTBQueueA TBQueue (LogRegion (Region m))
queue (LogMode -> Region m -> ConsoleLog -> LogRegion (Region m)
forall r. LogMode -> r -> ConsoleLog -> LogRegion r
LogRegion (Log
log Log -> Optic' A_Lens NoIx Log LogMode -> LogMode
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Log LogMode
#mode) Region m
region ConsoleLog
formatted)

-- | Writes the log to the file queue.
logToFileQueue ::
  ( HasCallStack,
    MonadSTM m,
    MonadTime m
  ) =>
  -- | How to display the command.
  KeyHideSwitch ->
  -- | FileLogging config.
  FileLoggingEnv ->
  -- | Log to send.
  Log ->
  m ()
logToFileQueue :: forall (m :: Type -> Type).
(HasCallStack, MonadSTM m, MonadTime m) =>
KeyHideSwitch -> FileLoggingEnv -> Log -> m ()
logToFileQueue KeyHideSwitch
keyHide FileLoggingEnv
fileLogging Log
log = do
  FileLog
formatted <- KeyHideSwitch -> FileLoggingEnv -> Log -> m FileLog
forall (m :: Type -> Type).
(HasCallStack, MonadTime m) =>
KeyHideSwitch -> FileLoggingEnv -> Log -> m FileLog
formatFileLog KeyHideSwitch
keyHide FileLoggingEnv
fileLogging Log
log
  TBQueue FileLog -> FileLog -> m ()
forall (m :: Type -> Type) a.
(HasCallStack, MonadSTM m) =>
TBQueue a -> a -> m ()
writeTBQueueA (FileLoggingEnv
fileLogging FileLoggingEnv
-> Optic' A_Lens NoIx FileLoggingEnv (TBQueue FileLog)
-> TBQueue FileLog
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  FileLoggingEnv
  FileLoggingEnv
  FileLogOpened
  FileLogOpened
#file Optic
  A_Lens
  NoIx
  FileLoggingEnv
  FileLoggingEnv
  FileLogOpened
  FileLogOpened
-> Optic
     A_Lens
     NoIx
     FileLogOpened
     FileLogOpened
     (TBQueue FileLog)
     (TBQueue FileLog)
-> Optic' A_Lens NoIx FileLoggingEnv (TBQueue FileLog)
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
  FileLogOpened
  FileLogOpened
  (TBQueue FileLog)
  (TBQueue FileLog)
#queue) FileLog
formatted