module Test.Sandwich.Formatters.Print.Logs where

import Control.Concurrent.STM
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Data.String.Interpolate
import System.IO
import Test.Sandwich.Formatters.Print.Color
import Test.Sandwich.Formatters.Print.Printing
import Test.Sandwich.Formatters.Print.Types
import Test.Sandwich.Formatters.Print.Util
import Test.Sandwich.Types.RunTree


printLogs :: (MonadIO m, MonadReader (PrintFormatter, Int, Handle) m, Foldable t) => TVar (t LogEntry) -> m ()
printLogs :: forall (m :: * -> *) (t :: * -> *).
(MonadIO m, MonadReader (PrintFormatter, Int, Handle) m,
 Foldable t) =>
TVar (t LogEntry) -> m ()
printLogs TVar (t LogEntry)
runTreeLogs = do
  (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PrintFormatter -> Maybe LogLevel
printFormatterLogLevel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> a
fst3)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe LogLevel
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just LogLevel
logLevel -> do
      t LogEntry
logEntries <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO TVar (t LogEntry)
runTreeLogs
      forall {m :: * -> *} {c} {b}.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t LogEntry
logEntries forall a b. (a -> b) -> a -> b
$ \LogEntry
entry ->
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogEntry -> LogLevel
logEntryLevel LogEntry
entry forall a. Ord a => a -> a -> Bool
>= LogLevel
logLevel) forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
LogEntry -> m ()
printLogEntry LogEntry
entry


printLogEntry :: LogEntry -> m ()
printLogEntry (LogEntry {UTCTime
Text
LogStr
LogLevel
Loc
logEntryStr :: LogEntry -> LogStr
logEntrySource :: LogEntry -> Text
logEntryLoc :: LogEntry -> Loc
logEntryTime :: LogEntry -> UTCTime
logEntryStr :: LogStr
logEntryLevel :: LogLevel
logEntrySource :: Text
logEntryLoc :: Loc
logEntryTime :: UTCTime
logEntryLevel :: LogEntry -> LogLevel
..}) = do
  forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
logTimestampColor (forall a. Show a => a -> String
show UTCTime
logEntryTime)

  case LogLevel
logEntryLevel of
    LogLevel
LevelDebug -> forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
debugColor String
" (DEBUG) "
    LogLevel
LevelInfo -> forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
infoColor String
" (INFO) "
    LogLevel
LevelWarn -> forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
warnColor String
" (WARN) "
    LogLevel
LevelError -> forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
errorColor String
" (ERROR) "
    LevelOther Text
x -> forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
infoColor [i| #{x} |]

  let Loc {loc_start :: Loc -> CharPos
loc_start=(Int
line, Int
ch), String
CharPos
loc_package :: Loc -> String
loc_module :: Loc -> String
loc_filename :: Loc -> String
loc_end :: Loc -> CharPos
loc_end :: CharPos
loc_module :: String
loc_package :: String
loc_filename :: String
..} = Loc
logEntryLoc
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"["
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
logFilenameColor String
loc_filename
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
":"
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
logLineColor (forall a. Show a => a -> String
show Int
line)
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
":"
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
logChColor (forall a. Show a => a -> String
show Int
ch)
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"] "

  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p (forall a. Show a => a -> String
show LogStr
logEntryStr)

  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"


debugColor :: Colour Float
debugColor = Colour Float
solarizedBlue
infoColor :: Colour Float
infoColor = Colour Float
solarizedYellow
warnColor :: Colour Float
warnColor = Colour Float
solarizedRed
errorColor :: Colour Float
errorColor = Colour Float
solarizedRed
otherColor :: Colour Float
otherColor = Colour Float
solarizedYellow

logFilenameColor :: Colour Float
logFilenameColor = Colour Float
solarizedViolet
logModuleColor :: Colour Float
logModuleColor = Colour Float
solarizedMagenta
logPackageColor :: Colour Float
logPackageColor = Colour Float
solarizedGreen
logLineColor :: Colour Float
logLineColor = Colour Float
solarizedCyan
logChColor :: Colour Float
logChColor = Colour Float
solarizedOrange
logFunctionColor :: Colour Float
logFunctionColor = Colour Float
solarizedBlue

logTimestampColor :: Colour Float
logTimestampColor = Colour Float
midGray