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