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 :: 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 <-
    IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isGitHubActions IO (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> IO Bool
hIsTerminalDevice Handle
stdout

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