-- | The 'MonadLog' type class of monads with logging capabilities.
module Log.Class (
    UTCTime
  , MonadLog(..)
  , logAttention
  , logInfo
  , logTrace
  , logAttention_
  , logInfo_
  , logTrace_
  ) where

import Control.Monad.Trans
import Control.Monad.Trans.Control
import Data.Aeson
import Data.Aeson.Types
import Data.Time
import qualified Data.Text as T

import Log.Data
import Log.Logger

-- | Represents the family of monads with logging capabilities. Each
-- 'MonadLog' carries with it some associated state (the logging
-- environment) that can be modified locally with 'localData' and
-- 'localDomain'.
class Monad m => MonadLog m where
  -- | Write a message to the log.
  logMessage
    :: LogLevel -- ^ Log level.
    -> T.Text   -- ^ Log message.
    -> Value    -- ^ Additional data associated with the message.
    -> m ()
  -- | Extend the additional data associated with each log message locally.
  localData   :: [Pair] -> m a -> m a
  -- | Extend the current application domain locally.
  localDomain :: T.Text -> m a -> m a
  -- | Override the current maximum log level.
  localMaxLogLevel :: LogLevel -> m a -> m a
  -- | Get current 'LoggerEnv' object. Useful for construction of logging
  -- functions that work in a different monad, see 'getLoggerIO' as an example.
  getLoggerEnv :: m LoggerEnv

-- | Generic, overlapping instance.
instance {-# OVERLAPPABLE #-} (
    MonadLog m
  , Monad (t m)
  , MonadTransControl t
  ) => MonadLog (t m) where
    logMessage :: LogLevel -> Text -> Value -> t m ()
logMessage LogLevel
level Text
message = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
level Text
message
    localData :: forall a. [Pair] -> t m a -> t m a
localData [Pair]
data_ t m a
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad (t m), Monad m) =>
(Run t -> m (StT t a)) -> t m a
controlT forall a b. (a -> b) -> a -> b
$ \Run t
run -> forall (m :: * -> *) a. MonadLog m => [Pair] -> m a -> m a
localData [Pair]
data_ (Run t
run t m a
m)
    localDomain :: forall a. Text -> t m a -> t m a
localDomain Text
domain t m a
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad (t m), Monad m) =>
(Run t -> m (StT t a)) -> t m a
controlT forall a b. (a -> b) -> a -> b
$ \Run t
run -> forall (m :: * -> *) a. MonadLog m => Text -> m a -> m a
localDomain Text
domain (Run t
run t m a
m)
    localMaxLogLevel :: forall a. LogLevel -> t m a -> t m a
localMaxLogLevel LogLevel
level t m a
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad (t m), Monad m) =>
(Run t -> m (StT t a)) -> t m a
controlT forall a b. (a -> b) -> a -> b
$ \Run t
run -> forall (m :: * -> *) a. MonadLog m => LogLevel -> m a -> m a
localMaxLogLevel LogLevel
level (Run t
run t m a
m)
    getLoggerEnv :: t m LoggerEnv
getLoggerEnv = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadLog m => m LoggerEnv
getLoggerEnv

----------------------------------------

-- | Log a message and its associated data using current time as the
-- event time and the 'LogAttention' log level.
logAttention :: (MonadLog m, ToJSON a) => T.Text -> a -> m ()
logAttention :: forall (m :: * -> *) a. (MonadLog m, ToJSON a) => Text -> a -> m ()
logAttention Text
msg = forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
LogAttention Text
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON

-- | Log a message and its associated data using current time as the
-- event time and the 'LogInfo' log level.
logInfo :: (MonadLog m, ToJSON a) => T.Text -> a -> m ()
logInfo :: forall (m :: * -> *) a. (MonadLog m, ToJSON a) => Text -> a -> m ()
logInfo Text
msg = forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
LogInfo Text
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON

-- | Log a message and its associated data using current time as the
-- event time and the 'LogTrace' log level.
logTrace :: (MonadLog m, ToJSON a) => T.Text -> a -> m ()
logTrace :: forall (m :: * -> *) a. (MonadLog m, ToJSON a) => Text -> a -> m ()
logTrace Text
msg = forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
LogTrace Text
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON

-- | Like 'logAttention', but without any additional associated data.
logAttention_ :: MonadLog m => T.Text -> m ()
logAttention_ :: forall (m :: * -> *). MonadLog m => Text -> m ()
logAttention_ = (forall (m :: * -> *) a. (MonadLog m, ToJSON a) => Text -> a -> m ()
`logAttention` Value
emptyObject)

-- | Like 'logInfo', but without any additional associated data.
logInfo_ :: MonadLog m => T.Text -> m ()
logInfo_ :: forall (m :: * -> *). MonadLog m => Text -> m ()
logInfo_ = (forall (m :: * -> *) a. (MonadLog m, ToJSON a) => Text -> a -> m ()
`logInfo` Value
emptyObject)

-- | Like 'logTrace', but without any additional associated data.
logTrace_ :: MonadLog m => T.Text -> m ()
logTrace_ :: forall (m :: * -> *). MonadLog m => Text -> m ()
logTrace_ = (forall (m :: * -> *) a. (MonadLog m, ToJSON a) => Text -> a -> m ()
`logTrace` Value
emptyObject)