{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
-- | Utility functions for printing

module Test.Sandwich.Formatters.Print.Printing where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import qualified Data.List as L
import System.Console.ANSI
import System.IO
import Test.Sandwich.Formatters.Print.Types
import Test.Sandwich.Util


-- * Printing functions for indented, colored, and with newline

pi :: String -> m ()
pi String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printIndentedWithColor Maybe SGR
forall a. Maybe a
Nothing String
msg
pic :: Colour Float -> String -> m ()
pic Colour Float
color String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printIndentedWithColor (SGR -> Maybe SGR
forall a. a -> Maybe a
Just (ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground Colour Float
color)) String
msg
pin :: String -> m ()
pin String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printIndentedWithColor Maybe SGR
forall a. Maybe a
Nothing (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
picn :: Colour Float -> String -> m ()
picn Colour Float
color String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printIndentedWithColor (SGR -> Maybe SGR
forall a. a -> Maybe a
Just (ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground Colour Float
color)) (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")

p :: String -> m ()
p String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *) b.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printWithColor Maybe SGR
forall a. Maybe a
Nothing String
msg
pc :: Colour Float -> String -> m ()
pc Colour Float
color String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *) b.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printWithColor (SGR -> Maybe SGR
forall a. a -> Maybe a
Just (ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground Colour Float
color)) String
msg
pn :: String -> m ()
pn String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *) b.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printWithColor Maybe SGR
forall a. Maybe a
Nothing (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
pcn :: Colour Float -> String -> m ()
pcn Colour Float
color String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *) b.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printWithColor (SGR -> Maybe SGR
forall a. a -> Maybe a
Just (ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground Colour Float
color)) (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")

pGreenLn :: String -> m ()
pGreenLn String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printIndentedWithColor (SGR -> Maybe SGR
forall a. a -> Maybe a
Just (ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Green)) (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
pYellowLn :: String -> m ()
pYellowLn String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printIndentedWithColor (SGR -> Maybe SGR
forall a. a -> Maybe a
Just (ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Yellow)) (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
pRedLn :: String -> m ()
pRedLn String
msg = Maybe SGR -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printIndentedWithColor (SGR -> Maybe SGR
forall a. a -> Maybe a
Just (ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Red)) (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n") -- Tried solarizedRed here but it was too orange

printIndentedWithColor :: Maybe SGR -> String -> m ()
printIndentedWithColor Maybe SGR
maybeColor String
msg = do
  (PrintFormatter {Bool
Int
Maybe LogLevel
printFormatterIndentSize :: PrintFormatter -> Int
printFormatterIncludeCallStacks :: PrintFormatter -> Bool
printFormatterVisibilityThreshold :: PrintFormatter -> Int
printFormatterLogLevel :: PrintFormatter -> Maybe LogLevel
printFormatterUseColor :: PrintFormatter -> Bool
printFormatterIndentSize :: Int
printFormatterIncludeCallStacks :: Bool
printFormatterVisibilityThreshold :: Int
printFormatterLogLevel :: Maybe LogLevel
printFormatterUseColor :: Bool
..}, Int
indent, Handle
h) <- m (PrintFormatter, Int, Handle)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
L.replicate Int
indent Char
' '
  Maybe SGR -> String -> m ()
forall (m :: * -> *) b.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Maybe SGR -> String -> m ()
printWithColor Maybe SGR
maybeColor String
msg

printWithColor :: Maybe SGR -> String -> m ()
printWithColor Maybe SGR
maybeColor String
msg = do
  (PrintFormatter {Bool
Int
Maybe LogLevel
printFormatterIndentSize :: Int
printFormatterIncludeCallStacks :: Bool
printFormatterVisibilityThreshold :: Int
printFormatterLogLevel :: Maybe LogLevel
printFormatterUseColor :: Bool
printFormatterIndentSize :: PrintFormatter -> Int
printFormatterIncludeCallStacks :: PrintFormatter -> Bool
printFormatterVisibilityThreshold :: PrintFormatter -> Int
printFormatterLogLevel :: PrintFormatter -> Maybe LogLevel
printFormatterUseColor :: PrintFormatter -> Bool
..}, b
_, Handle
h) <- m (PrintFormatter, b, Handle)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
printFormatterUseColor) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe SGR -> (SGR -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe SGR
maybeColor ((SGR -> m ()) -> m ()) -> (SGR -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SGR
color -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [SGR
color]
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
h String
msg
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
printFormatterUseColor) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe SGR -> (SGR -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe SGR
maybeColor ((SGR -> m ()) -> m ()) -> (SGR -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SGR
_ -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [SGR
Reset]