module Test.Sandwich.Formatters.Print.Types where

import Control.Monad.Logger

data PrintFormatter = PrintFormatter {
  PrintFormatter -> Bool
printFormatterUseColor :: Bool
  -- ^ Whether to use color in output. Defaults to 'True'.
  , PrintFormatter -> Maybe LogLevel
printFormatterLogLevel :: Maybe LogLevel
  -- ^ Log level to show in output. Defaults to 'LevelWarn'.
  , PrintFormatter -> Int
printFormatterVisibilityThreshold :: Int
  -- ^ Visibility threshold. Nodes above this threshold will not be shown.
  , PrintFormatter -> Bool
printFormatterIncludeCallStacks :: Bool
  -- ^ Whether to include callstacks with failures.
  , PrintFormatter -> Int
printFormatterIndentSize :: Int
  -- ^ The indentation unit in spaces. Defaults to 4.
  } deriving (Int -> PrintFormatter -> ShowS
[PrintFormatter] -> ShowS
PrintFormatter -> String
(Int -> PrintFormatter -> ShowS)
-> (PrintFormatter -> String)
-> ([PrintFormatter] -> ShowS)
-> Show PrintFormatter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrintFormatter] -> ShowS
$cshowList :: [PrintFormatter] -> ShowS
show :: PrintFormatter -> String
$cshow :: PrintFormatter -> String
showsPrec :: Int -> PrintFormatter -> ShowS
$cshowsPrec :: Int -> PrintFormatter -> ShowS
Show)

defaultPrintFormatter :: PrintFormatter
defaultPrintFormatter :: PrintFormatter
defaultPrintFormatter = PrintFormatter :: Bool -> Maybe LogLevel -> Int -> Bool -> Int -> PrintFormatter
PrintFormatter {
  printFormatterUseColor :: Bool
printFormatterUseColor = Bool
True
  , printFormatterLogLevel :: Maybe LogLevel
printFormatterLogLevel = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelWarn
  , printFormatterVisibilityThreshold :: Int
printFormatterVisibilityThreshold = Int
50
  , printFormatterIncludeCallStacks :: Bool
printFormatterIncludeCallStacks = Bool
True
  , printFormatterIndentSize :: Int
printFormatterIndentSize = Int
4
  }