{-# LANGUAGE RecordWildCards #-}
module Test.Mockery.Logging (
  captureLogMessages
, captureLogMessages_
, LogLevel(..)
) where

import           Control.Exception
import           Data.IORef.Compat
import           Prelude ()
import           Prelude.Compat
import           System.Logging.Facade.Types
import           System.Logging.Facade.Sink

-- | Capture all log messages produced by an IO action.
-- Logs are kept in memory.
captureLogMessages :: IO a -> IO ([(LogLevel, String)], a)
captureLogMessages :: IO a -> IO ([(LogLevel, String)], a)
captureLogMessages action :: IO a
action = IO LogSink
-> (LogSink -> IO ())
-> (LogSink -> IO ([(LogLevel, String)], a))
-> IO ([(LogLevel, String)], a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO LogSink
getLogSink LogSink -> IO ()
setLogSink LogSink -> IO ([(LogLevel, String)], a)
forall p. p -> IO ([(LogLevel, String)], a)
act
  where
    logToRef :: IORef [a] -> a -> IO ()
logToRef ref :: IORef [a]
ref record :: a
record = IORef [a] -> ([a] -> ([a], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [a]
ref (([a] -> ([a], ())) -> IO ()) -> ([a] -> ([a], ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \logs :: [a]
logs -> (a
record a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
logs, ())
    unwrap :: LogRecord -> (LogLevel, String)
unwrap LogRecord{..} = (LogLevel
logRecordLevel, String
logRecordMessage)
    act :: p -> IO ([(LogLevel, String)], a)
act _  = do
      IORef [LogRecord]
ref <- [LogRecord] -> IO (IORef [LogRecord])
forall a. a -> IO (IORef a)
newIORef []
      LogSink -> IO ()
setLogSink (LogSink -> IO ()) -> LogSink -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef [LogRecord] -> LogSink
forall a. IORef [a] -> a -> IO ()
logToRef IORef [LogRecord]
ref
      a
val <- IO a
action
      [LogRecord]
logs <- IORef [LogRecord] -> IO [LogRecord]
forall a. IORef a -> IO a
readIORef IORef [LogRecord]
ref
      ([(LogLevel, String)], a) -> IO ([(LogLevel, String)], a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LogRecord -> (LogLevel, String)
unwrap (LogRecord -> (LogLevel, String))
-> [LogRecord] -> [(LogLevel, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LogRecord] -> [LogRecord]
forall a. [a] -> [a]
reverse [LogRecord]
logs, a
val)

-- | Like 'captureLogsMessages', but ignores the result.
captureLogMessages_ :: IO a -> IO [(LogLevel, String)]
captureLogMessages_ :: IO a -> IO [(LogLevel, String)]
captureLogMessages_ action :: IO a
action = ([(LogLevel, String)], a) -> [(LogLevel, String)]
forall a b. (a, b) -> a
fst (([(LogLevel, String)], a) -> [(LogLevel, String)])
-> IO ([(LogLevel, String)], a) -> IO [(LogLevel, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO ([(LogLevel, String)], a)
forall a. IO a -> IO ([(LogLevel, String)], a)
captureLogMessages IO a
action