Color.hs

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 = do
  -- The stdout handle will not appear as a terminal on GitHub Actions, but it
  -- does support color escapes.
  shouldColorize <-
    liftIO $ (||) <$> isGitHubActions <*> hIsTerminalDevice stdout

  pure $ if shouldColorize
    then \c x -> escape Reset <> escape c <> x <> escape Reset
    else \_ x -> x
  where isGitHubActions = (== Just "true") <$> lookupEnv "GITHUB_ACTIONS"

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