-- | The 'Logger' type - implementation details.
{-# OPTIONS_HADDOCK hide #-}
module Log.Internal.Logger (
    Logger(..)
  , execLogger
  , waitForLogger
  , shutdownLogger
  , withLogger
  ) where

import Control.Exception

import Log.Data

-- | An object used for communication with a logger thread that
-- outputs 'LogMessage's using e.g. PostgreSQL, Elasticsearch or
-- stdout (depending on the back-end chosen).
data Logger = Logger {
  Logger -> LogMessage -> IO ()
loggerWriteMessage :: !(LogMessage -> IO ()) -- ^ Output a 'LogMessage'.
, Logger -> IO ()
loggerWaitForWrite :: !(IO ())
                     -- ^ Wait for the logger to output all messages
                     -- in its input queue (in the case logging is
                     -- done asynchronously).
, Logger -> IO ()
loggerShutdown     :: !(IO ())
                     -- ^ Kill the logger thread. Subsequent attempts
                     -- to write messages to the logger will raise an
                     -- exception.
}

-- | Execute logger to serialize a 'LogMessage'.
execLogger :: Logger -> LogMessage -> IO ()
execLogger :: Logger -> LogMessage -> IO ()
execLogger Logger{IO ()
LogMessage -> IO ()
loggerShutdown :: IO ()
loggerWaitForWrite :: IO ()
loggerWriteMessage :: LogMessage -> IO ()
loggerShutdown :: Logger -> IO ()
loggerWaitForWrite :: Logger -> IO ()
loggerWriteMessage :: Logger -> LogMessage -> IO ()
..} = LogMessage -> IO ()
loggerWriteMessage

-- | Wait until all 'LogMessage's stored in the internal queue are
-- serialized.
waitForLogger :: Logger -> IO ()
waitForLogger :: Logger -> IO ()
waitForLogger Logger{IO ()
LogMessage -> IO ()
loggerShutdown :: IO ()
loggerWaitForWrite :: IO ()
loggerWriteMessage :: LogMessage -> IO ()
loggerShutdown :: Logger -> IO ()
loggerWaitForWrite :: Logger -> IO ()
loggerWriteMessage :: Logger -> LogMessage -> IO ()
..} = IO ()
loggerWaitForWrite

-- | Shutdown the logger thread associated with this 'Logger'
-- object. Subsequent attempts to write messages via this 'Logger'
-- will result in an exception.
shutdownLogger :: Logger -> IO ()
shutdownLogger :: Logger -> IO ()
shutdownLogger Logger{IO ()
LogMessage -> IO ()
loggerShutdown :: IO ()
loggerWaitForWrite :: IO ()
loggerWriteMessage :: LogMessage -> IO ()
loggerShutdown :: Logger -> IO ()
loggerWaitForWrite :: Logger -> IO ()
loggerWriteMessage :: Logger -> LogMessage -> IO ()
..} = IO ()
loggerShutdown

-- | 'bracket'-like execution of an 'IO' action, verifying all messages
-- are properly logged. See 'mkBulkLogger'.
withLogger :: Logger -> (Logger -> IO r) -> IO r
withLogger :: forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger Logger -> IO r
act = Logger -> IO r
act Logger
logger forall a b. IO a -> IO b -> IO a
`finally` IO ()
cleanup
  where
    cleanup :: IO ()
cleanup = Logger -> IO ()
waitForLogger Logger
logger forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Logger -> IO ()
shutdownLogger Logger
logger
-- Prevent GHC from inlining this function so its callers are small and
-- considered for inlining instead (as they will be generalized to MonadIO or
-- MonadUnliftIO).
{-# NOINLINE withLogger #-}

instance Semigroup Logger where
  Logger
l1 <> :: Logger -> Logger -> Logger
<> Logger
l2 = Logger {
    loggerWriteMessage :: LogMessage -> IO ()
loggerWriteMessage = \LogMessage
msg -> do
      Logger -> LogMessage -> IO ()
loggerWriteMessage Logger
l1 LogMessage
msg
      Logger -> LogMessage -> IO ()
loggerWriteMessage Logger
l2 LogMessage
msg
  , loggerWaitForWrite :: IO ()
loggerWaitForWrite = do
      Logger -> IO ()
loggerWaitForWrite Logger
l1
      Logger -> IO ()
loggerWaitForWrite Logger
l2
  , loggerShutdown :: IO ()
loggerShutdown     = do
      Logger -> IO ()
loggerShutdown Logger
l1
      Logger -> IO ()
loggerShutdown Logger
l2
  }

-- | Composition of 'Logger' objects.
instance Monoid Logger where
  mempty :: Logger
mempty  = (LogMessage -> IO ()) -> IO () -> IO () -> Logger
Logger (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  mappend :: Logger -> Logger -> Logger
mappend = forall a. Semigroup a => a -> a -> a
(<>)