-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogList -> LogList -> Bool
$c/= :: LogList -> LogList -> Bool
== :: LogList -> LogList -> Bool
$c== :: 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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) = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [LogMessage]
ll forall a b. (a -> b) -> a -> b
$ \[LogMessage]
msgs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! LogMessage
msg 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) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [LogMessage]
ll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
unlift -> forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger (forall a. m a -> IO a
unlift forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> m r
act)
  where
    logger :: Logger
logger = Logger
      { loggerWriteMessage :: LogMessage -> IO ()
loggerWriteMessage = forall (m :: * -> *). MonadIO m => LogList -> LogMessage -> m ()
putLogList LogList
ll
      , loggerWaitForWrite :: IO ()
loggerWaitForWrite = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , loggerShutdown :: IO ()
loggerShutdown     = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      }