-- | 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")

pGreen :: String -> m ()
pGreen 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
pGreenLn :: String -> m ()
pGreenLn String
msg = String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pGreen (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")

pYellow :: String -> m ()
pYellow 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
pYellowLn :: String -> m ()
pYellowLn String
msg = String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pYellow (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")

pRed :: String -> m ()
pRed 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 -- Tried solarizedRed here but it was too orange
pRedLn :: String -> m ()
pRedLn String
msg = String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pRed (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")

printIndentedWithColor :: Maybe SGR -> String -> m ()
printIndentedWithColor Maybe SGR
maybeColor String
msg = do
  (PrintFormatter {}, Int
indent, Handle
h) <- m (PrintFormatter, Int, Handle)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> m ()
forall a. IO a -> m a
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
printFormatterUseColor :: Bool
printFormatterUseColor :: PrintFormatter -> Bool
printFormatterUseColor}, 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 a. IO a -> m a
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 a. IO a -> m a
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 a. IO a -> m a
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]