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

import Data.Semigroup
import Control.Exception
import Prelude

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{..} = LogMessage -> IO ()
loggerWriteMessage

-- | Wait until all 'LogMessage's stored in the internal queue are
-- serialized.
waitForLogger :: Logger -> IO ()
waitForLogger :: Logger -> IO ()
waitForLogger Logger{..} = 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 ()
loggerShutdown

-- | 'bracket'-like execution of an 'IO' action, verifying all messages
-- are properly logged. See 'mkBulkLogger'.
withLogger :: Logger -> (Logger -> IO r) -> IO r
withLogger :: Logger -> (Logger -> IO r) -> IO r
withLogger logger :: Logger
logger act :: Logger -> IO r
act = Logger -> IO r
act Logger
logger IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`finally` IO ()
cleanup
  where
    cleanup :: IO ()
cleanup = Logger -> IO ()
waitForLogger Logger
logger IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Logger -> IO ()
shutdownLogger Logger
logger

instance Semigroup Logger where
  l1 :: Logger
l1 <> :: Logger -> Logger -> Logger
<> l2 :: Logger
l2 = $WLogger :: (LogMessage -> IO ()) -> IO () -> IO () -> Logger
Logger {
    loggerWriteMessage :: LogMessage -> IO ()
loggerWriteMessage = \msg :: 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 (IO () -> LogMessage -> IO ()
forall a b. a -> b -> a
const (IO () -> LogMessage -> IO ()) -> IO () -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  mappend :: Logger -> Logger -> Logger
mappend = Logger -> Logger -> Logger
forall a. Semigroup a => a -> a -> a
(<>)