{-# 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
captureLogMessages :: IO a -> IO ([(LogLevel, String)], a)
captureLogMessages :: IO a -> IO ([(LogLevel, String)], a)
captureLogMessages 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 IORef [a]
ref 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
$ \[a]
logs -> (a
record a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
logs, ())
unwrap :: LogRecord -> (LogLevel, String)
unwrap LogRecord{String
Maybe Location
LogLevel
logRecordMessage :: LogRecord -> String
logRecordLocation :: LogRecord -> Maybe Location
logRecordLevel :: LogRecord -> LogLevel
logRecordMessage :: String
logRecordLocation :: Maybe Location
logRecordLevel :: LogLevel
..} = (LogLevel
logRecordLevel, String
logRecordMessage)
act :: p -> IO ([(LogLevel, String)], a)
act p
_ = 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)
captureLogMessages_ :: IO a -> IO [(LogLevel, String)]
captureLogMessages_ :: IO a -> IO [(LogLevel, String)]
captureLogMessages_ 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