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 ()