-- | LogList logging backed.
module Log.Backend.LogList
  ( LogList
  , newLogList
  , getLogList
  , putLogList
  , clearLogList
  , withLogListLogger
  ) where

import Control.Concurrent.MVar
import Control.Monad.IO.Unlift

import Log.Data
import Log.Internal.Logger

newtype LogList = LogList (MVar [LogMessage])
  deriving LogList -> LogList -> Bool
(LogList -> LogList -> Bool)
-> (LogList -> LogList -> Bool) -> Eq LogList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogList -> LogList -> Bool
== :: LogList -> LogList -> Bool
$c/= :: LogList -> LogList -> Bool
/= :: LogList -> LogList -> Bool
Eq

-- | Create a new, empty list.
newLogList :: MonadIO m => m LogList
newLogList :: forall (m :: * -> *). MonadIO m => m LogList
newLogList = MVar [LogMessage] -> LogList
LogList (MVar [LogMessage] -> LogList)
-> m (MVar [LogMessage]) -> m LogList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (MVar [LogMessage]) -> m (MVar [LogMessage])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([LogMessage] -> IO (MVar [LogMessage])
forall a. a -> IO (MVar a)
newMVar [])

-- | Retrieve messages stored in the list.
getLogList :: MonadIO m => LogList -> m [LogMessage]
getLogList :: forall (m :: * -> *). MonadIO m => LogList -> m [LogMessage]
getLogList (LogList MVar [LogMessage]
ll) = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> m [LogMessage] -> m [LogMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [LogMessage] -> m [LogMessage]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar [LogMessage] -> IO [LogMessage]
forall a. MVar a -> IO a
readMVar MVar [LogMessage]
ll)

-- | Put a message into the list.
putLogList :: MonadIO m => LogList -> LogMessage -> m ()
putLogList :: forall (m :: * -> *). MonadIO m => LogList -> LogMessage -> m ()
putLogList (LogList MVar [LogMessage]
ll) LogMessage
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (([LogMessage] -> IO [LogMessage]) -> IO ())
-> ([LogMessage] -> IO [LogMessage])
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar [LogMessage] -> ([LogMessage] -> IO [LogMessage]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [LogMessage]
ll (([LogMessage] -> IO [LogMessage]) -> m ())
-> ([LogMessage] -> IO [LogMessage]) -> m ()
forall a b. (a -> b) -> a -> b
$ \[LogMessage]
msgs -> [LogMessage] -> IO [LogMessage]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LogMessage] -> IO [LogMessage])
-> [LogMessage] -> IO [LogMessage]
forall a b. (a -> b) -> a -> b
$! LogMessage
msg LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: [LogMessage]
msgs

-- | Clear the list.
clearLogList :: MonadIO m => LogList -> m ()
clearLogList :: forall (m :: * -> *). MonadIO m => LogList -> m ()
clearLogList (LogList MVar [LogMessage]
ll) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (IO [LogMessage] -> IO ()) -> IO [LogMessage] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar [LogMessage] -> ([LogMessage] -> IO [LogMessage]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [LogMessage]
ll (([LogMessage] -> IO [LogMessage]) -> IO ())
-> (IO [LogMessage] -> [LogMessage] -> IO [LogMessage])
-> IO [LogMessage]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [LogMessage] -> [LogMessage] -> IO [LogMessage]
forall a b. a -> b -> a
const (IO [LogMessage] -> m ()) -> IO [LogMessage] -> m ()
forall a b. (a -> b) -> a -> b
$ [LogMessage] -> IO [LogMessage]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Creates a logger that stores messages in the given 'LogList'.
withLogListLogger :: MonadUnliftIO m => LogList -> (Logger -> m r) -> m r
withLogListLogger :: forall (m :: * -> *) r.
MonadUnliftIO m =>
LogList -> (Logger -> m r) -> m r
withLogListLogger LogList
ll Logger -> m r
act = ((forall a. m a -> IO a) -> IO r) -> m r
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO r) -> m r)
-> ((forall a. m a -> IO a) -> IO r) -> m r
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
unlift -> Logger -> (Logger -> IO r) -> IO r
forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger (m r -> IO r
forall a. m a -> IO a
unlift (m r -> IO r) -> (Logger -> m r) -> Logger -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> m r
act)
  where
    logger :: Logger
logger = Logger
      { loggerWriteMessage :: LogMessage -> IO ()
loggerWriteMessage = LogList -> LogMessage -> IO ()
forall (m :: * -> *). MonadIO m => LogList -> LogMessage -> m ()
putLogList LogList
ll
      , loggerWaitForWrite :: IO ()
loggerWaitForWrite = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , loggerShutdown :: IO ()
loggerShutdown     = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      }