module Test.Sandwich.Interpreters.RunTree.Logging ( logToMemory , logToMemoryAndFile , LogFn , LogEntryFormatter ) where import Control.Concurrent.STM import Control.Monad import Control.Monad.Logger import qualified Data.ByteString.Char8 as BS8 import Data.Sequence import Data.Time.Clock import System.IO import Test.Sandwich.Types.RunTree logToMemory :: Maybe LogLevel -> TVar (Seq LogEntry) -> Loc -> LogSource -> LogLevel -> LogStr -> IO () logToMemory :: Maybe LogLevel -> TVar (Seq LogEntry) -> Loc -> LogSource -> LogLevel -> LogStr -> IO () logToMemory Maybe LogLevel Nothing TVar (Seq LogEntry) _ Loc _ LogSource _ LogLevel _ LogStr _ = forall (m :: * -> *) a. Monad m => a -> m a return () logToMemory (Just LogLevel minLevel) TVar (Seq LogEntry) logs Loc loc LogSource logSrc LogLevel logLevel LogStr logStr = forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (LogLevel logLevel forall a. Ord a => a -> a -> Bool >= LogLevel minLevel) forall a b. (a -> b) -> a -> b $ do UTCTime ts <- IO UTCTime getCurrentTime forall a. STM a -> IO a atomically forall a b. (a -> b) -> a -> b $ forall a. TVar a -> (a -> a) -> STM () modifyTVar TVar (Seq LogEntry) logs (forall a. Seq a -> a -> Seq a |> UTCTime -> Loc -> LogSource -> LogLevel -> LogStr -> LogEntry LogEntry UTCTime ts Loc loc LogSource logSrc LogLevel logLevel LogStr logStr) logToMemoryAndFile :: Maybe LogLevel -> Maybe LogLevel -> LogEntryFormatter -> TVar (Seq LogEntry) -> Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO () logToMemoryAndFile :: Maybe LogLevel -> Maybe LogLevel -> LogEntryFormatter -> TVar (Seq LogEntry) -> Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO () logToMemoryAndFile Maybe LogLevel maybeMemLogLevel Maybe LogLevel maybeSavedLogLevel LogEntryFormatter formatter TVar (Seq LogEntry) logs Handle h Loc loc LogSource logSrc LogLevel logLevel LogStr logStr = do Maybe UTCTime maybeTs <- case Maybe LogLevel maybeMemLogLevel of Just LogLevel x | LogLevel x forall a. Ord a => a -> a -> Bool <= LogLevel logLevel -> do UTCTime ts <- IO UTCTime getCurrentTime forall a. STM a -> IO a atomically forall a b. (a -> b) -> a -> b $ forall a. TVar a -> (a -> a) -> STM () modifyTVar TVar (Seq LogEntry) logs (forall a. Seq a -> a -> Seq a |> UTCTime -> Loc -> LogSource -> LogLevel -> LogStr -> LogEntry LogEntry UTCTime ts Loc loc LogSource logSrc LogLevel logLevel LogStr logStr) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just UTCTime ts Maybe LogLevel _ -> forall (m :: * -> *) a. Monad m => a -> m a return forall a. Maybe a Nothing case Maybe LogLevel maybeSavedLogLevel of Just LogLevel x | LogLevel x forall a. Ord a => a -> a -> Bool <= LogLevel logLevel -> do UTCTime ts <- forall b a. b -> (a -> b) -> Maybe a -> b maybe IO UTCTime getCurrentTime forall (m :: * -> *) a. Monad m => a -> m a return Maybe UTCTime maybeTs Handle -> ByteString -> IO () BS8.hPutStr Handle h forall a b. (a -> b) -> a -> b $ LogEntryFormatter formatter UTCTime ts Loc loc LogSource logSrc LogLevel logLevel LogStr logStr Maybe LogLevel _ -> forall (m :: * -> *) a. Monad m => a -> m a return ()