{-# OPTIONS_HADDOCK hide #-}
module Log.Internal.Logger (
Logger(..)
, execLogger
, waitForLogger
, shutdownLogger
, withLogger
) where
import Data.Semigroup
import Control.Exception
import Prelude
import Log.Data
data Logger = Logger {
Logger -> LogMessage -> IO ()
loggerWriteMessage :: !(LogMessage -> IO ())
, Logger -> IO ()
loggerWaitForWrite :: !(IO ())
, Logger -> IO ()
loggerShutdown :: !(IO ())
}
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
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
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
withLogger :: Logger -> (Logger -> IO r) -> IO r
withLogger :: Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger 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
Logger
l1 <> :: Logger -> Logger -> Logger
<> Logger
l2 = Logger :: (LogMessage -> IO ()) -> IO () -> IO () -> Logger
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
}
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
(<>)