module Test.Hspec.Expectations.Json.Color
  ( Color (..)
  , getColorize
  ) where

import Prelude

import Control.Monad.IO.Class (MonadIO (..))
import System.Environment (lookupEnv)
import System.IO (hIsTerminalDevice, stdout)

data Color = Reset | Red | Green

getColorize :: MonadIO m => m (Color -> String -> String)
getColorize :: forall (m :: * -> *). MonadIO m => m (Color -> String -> String)
getColorize = do
  -- The stdout handle will not appear as a terminal on GitHub Actions, but it
  -- does support color escapes.
  Bool
shouldColorize <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isGitHubActions forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> IO Bool
hIsTerminalDevice Handle
stdout

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    if Bool
shouldColorize
      then \Color
c String
x -> Color -> String
escape Color
Reset forall a. Semigroup a => a -> a -> a
<> Color -> String
escape Color
c forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> Color -> String
escape Color
Reset
      else \Color
_ String
x -> String
x
 where
  isGitHubActions :: IO Bool
isGitHubActions = (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"GITHUB_ACTIONS"

escape :: Color -> String
escape :: Color -> String
escape = \case
  Color
Reset -> String
"\ESC[0m"
  Color
Red -> String
"\ESC[0;31m"
  Color
Green -> String
"\ESC[0;32m"