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

import Control.Concurrent.MVar
import System.IO
import Prelude

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
/= :: LogList -> LogList -> Bool
$c/= :: LogList -> LogList -> Bool
== :: LogList -> LogList -> Bool
$c== :: LogList -> LogList -> Bool
Eq

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

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

-- | Put a message into the list.
putLogList :: LogList -> LogMessage -> IO ()
putLogList :: LogList -> LogMessage -> IO ()
putLogList (LogList ll :: MVar [LogMessage]
ll) msg :: LogMessage
msg = MVar [LogMessage] -> ([LogMessage] -> IO [LogMessage]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [LogMessage]
ll (([LogMessage] -> IO [LogMessage]) -> IO ())
-> ([LogMessage] -> IO [LogMessage]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \msgs :: [LogMessage]
msgs -> [LogMessage] -> IO [LogMessage]
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 :: LogList -> IO ()
clearLogList :: LogList -> IO ()
clearLogList (LogList ll :: MVar [LogMessage]
ll) = 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] -> IO ()) -> IO [LogMessage] -> IO ()
forall a b. (a -> b) -> a -> b
$ [LogMessage] -> IO [LogMessage]
forall (m :: * -> *) a. Monad m => a -> m a
return []

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