-- | 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 Prelude
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
  -- | 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 = m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (Value -> m ()) -> Value -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> Text -> Value -> m ()
forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
level Text
message
    localData :: [Pair] -> t m a -> t m a
localData [Pair]
data_ t m a
m = (Run t -> m (StT t a)) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad (t m), Monad m) =>
(Run t -> m (StT t a)) -> t m a
controlT ((Run t -> m (StT t a)) -> t m a)
-> (Run t -> m (StT t a)) -> t m a
forall a b. (a -> b) -> a -> b
$ \Run t
run -> [Pair] -> m (StT t a) -> m (StT t a)
forall (m :: * -> *) a. MonadLog m => [Pair] -> m a -> m a
localData [Pair]
data_ (t m a -> m (StT t a)
Run t
run t m a
m)
    localDomain :: Text -> t m a -> t m a
localDomain Text
domain t m a
m = (Run t -> m (StT t a)) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad (t m), Monad m) =>
(Run t -> m (StT t a)) -> t m a
controlT ((Run t -> m (StT t a)) -> t m a)
-> (Run t -> m (StT t a)) -> t m a
forall a b. (a -> b) -> a -> b
$ \Run t
run -> Text -> m (StT t a) -> m (StT t a)
forall (m :: * -> *) a. MonadLog m => Text -> m a -> m a
localDomain Text
domain (t m a -> m (StT t a)
Run t
run t m a
m)
    getLoggerEnv :: t m LoggerEnv
getLoggerEnv = m LoggerEnv -> t m LoggerEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m LoggerEnv
forall (m :: * -> *). MonadLog m => m LoggerEnv
getLoggerEnv

controlT :: (MonadTransControl t, Monad (t m), Monad m)
         => (Run t -> m (StT t a)) -> t m a
controlT :: (Run t -> m (StT t a)) -> t m a
controlT Run t -> m (StT t a)
f = (Run t -> m (StT t a)) -> t m (StT t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith Run t -> m (StT t a)
f t m (StT t a) -> (StT t a -> t m a) -> t m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (StT t a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT t a) -> t m a)
-> (StT t a -> m (StT t a)) -> StT t a -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StT t a -> m (StT t a)
forall (m :: * -> *) a. Monad m => a -> m a
return

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

-- | 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 :: Text -> a -> m ()
logAttention Text
msg = LogLevel -> Text -> Value -> m ()
forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
LogAttention Text
msg (Value -> m ()) -> (a -> Value) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
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 :: Text -> a -> m ()
logInfo Text
msg = LogLevel -> Text -> Value -> m ()
forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
LogInfo Text
msg (Value -> m ()) -> (a -> Value) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
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 :: Text -> a -> m ()
logTrace Text
msg = LogLevel -> Text -> Value -> m ()
forall (m :: * -> *).
MonadLog m =>
LogLevel -> Text -> Value -> m ()
logMessage LogLevel
LogTrace Text
msg (Value -> m ()) -> (a -> Value) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON

-- | Like 'logAttention', but without any additional associated data.
logAttention_ :: MonadLog m => T.Text -> m ()
logAttention_ :: Text -> m ()
logAttention_ = (Text -> Value -> m ()
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_ :: Text -> m ()
logInfo_ = (Text -> Value -> m ()
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_ :: Text -> m ()
logTrace_ = (Text -> Value -> m ()
forall (m :: * -> *) a. (MonadLog m, ToJSON a) => Text -> a -> m ()
`logTrace` Value
emptyObject)