{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

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

#if MIN_VERSION_mtl(2,3,0)
import Control.Monad
#endif


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


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

  case LogLevel
logEntryLevel of
    LogLevel
LevelDebug -> Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
debugColor String
" (DEBUG) "
    LogLevel
LevelInfo -> Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
infoColor String
" (INFO) "
    LogLevel
LevelWarn -> Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
warnColor String
" (WARN) "
    LogLevel
LevelError -> Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
errorColor String
" (ERROR) "
    LevelOther Text
x -> Colour Float -> String -> m ()
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_filename :: String
loc_package :: String
loc_module :: String
loc_end :: CharPos
loc_filename :: Loc -> String
loc_package :: Loc -> String
loc_module :: Loc -> String
loc_end :: Loc -> CharPos
..} = Loc
logEntryLoc
  String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"["
  Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
logFilenameColor String
loc_filename
  String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
":"
  Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
logLineColor (Int -> String
forall a. Show a => a -> String
show Int
line)
  String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
":"
  Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
logChColor (Int -> String
forall a. Show a => a -> String
show Int
ch)
  String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"] "

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

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