-- | Load a 'JUnitConfig' using environment variables
module Test.Hspec.JUnit.Config.Env
  ( envJUnitEnabled
  , envJUnitConfig

    -- * Exported for testing
  , readJUnitConfig
  ) where

import Prelude

import Data.Semigroup (Endo (..))
import Data.Text (pack, unpack)
import qualified Data.Text as T
import System.Directory (getCurrentDirectory)
import System.Environment (getEnvironment, lookupEnv)
import System.FilePath (takeBaseName)
import Test.Hspec.JUnit.Config

-- | Is @JUNIT_ENABLED=1@ set in the environment?
envJUnitEnabled :: IO Bool
envJUnitEnabled :: IO Bool
envJUnitEnabled = (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"1") (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
envPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"ENABLED")

-- | Produce a 'JUnitConfig' by reading environment variables
--
-- Variable names align with setter functions from "Test.Hspec.JUnit.Config":
--
-- * @JUNIT_OUTPUT_DIRECTORY@ 'setJUnitConfigOutputDirectory'
-- * @JUNIT_OUTPUT_NAME@ 'setJUnitConfigOutputName'
-- * and so on
--
-- Environment variable values will have the string @{base}@ replaced with the
-- basename of the current directory. This can be useful in a monorepository of
-- multiple packages, for example: @JUNIT_OUTPUT_FILE={base}.xml@
envJUnitConfig :: IO JUnitConfig
envJUnitConfig :: IO JUnitConfig
envJUnitConfig = do
  [(String, String)]
env <- IO [(String, String)]
getEnvironment
  String
base <- String -> String
takeBaseName (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getCurrentDirectory
  JUnitConfig -> IO JUnitConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JUnitConfig -> IO JUnitConfig) -> JUnitConfig -> IO JUnitConfig
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> JUnitConfig
readJUnitConfig String
base [(String, String)]
env

readJUnitConfig :: FilePath -> [(String, String)] -> JUnitConfig
readJUnitConfig :: String -> [(String, String)] -> JUnitConfig
readJUnitConfig String
base [(String, String)]
env = JUnitConfig -> JUnitConfig
modify (JUnitConfig -> JUnitConfig) -> JUnitConfig -> JUnitConfig
forall a b. (a -> b) -> a -> b
$ Text -> JUnitConfig
defaultJUnitConfig (Text -> JUnitConfig) -> Text -> JUnitConfig
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
base
 where
  modify :: JUnitConfig -> JUnitConfig
modify =
    Endo JUnitConfig -> JUnitConfig -> JUnitConfig
forall a. Endo a -> a -> a
appEndo (Endo JUnitConfig -> JUnitConfig -> JUnitConfig)
-> Endo JUnitConfig -> JUnitConfig -> JUnitConfig
forall a b. (a -> b) -> a -> b
$
      ((JUnitConfig -> JUnitConfig) -> Endo JUnitConfig)
-> [JUnitConfig -> JUnitConfig] -> Endo JUnitConfig
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (JUnitConfig -> JUnitConfig) -> Endo JUnitConfig
forall a. (a -> a) -> Endo a
Endo
        [ String
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
readEnv String
"OUTPUT_DIRECTORY" String -> JUnitConfig -> JUnitConfig
setJUnitConfigOutputDirectory
        , String
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
readEnv String
"OUTPUT_NAME" String -> JUnitConfig -> JUnitConfig
setJUnitConfigOutputName
        , String
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
readEnv String
"OUTPUT_FILE" String -> JUnitConfig -> JUnitConfig
setJUnitConfigOutputFile
        , String
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
readEnv String
"SUITE_NAME" ((String -> JUnitConfig -> JUnitConfig)
 -> JUnitConfig -> JUnitConfig)
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
forall a b. (a -> b) -> a -> b
$ Text -> JUnitConfig -> JUnitConfig
setJUnitConfigSuiteName (Text -> JUnitConfig -> JUnitConfig)
-> (String -> Text) -> String -> JUnitConfig -> JUnitConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
        , String
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
readEnv String
"SOURCE_PATH_PREFIX" String -> JUnitConfig -> JUnitConfig
setJUnitConfigSourcePathPrefix
        , String
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
readEnv String
"DROP_CONSOLE_FORMATTING" ((String -> JUnitConfig -> JUnitConfig)
 -> JUnitConfig -> JUnitConfig)
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
forall a b. (a -> b) -> a -> b
$
            Bool -> JUnitConfig -> JUnitConfig
setJUnitConfigDropConsoleFormatting (Bool -> JUnitConfig -> JUnitConfig)
-> (String -> Bool) -> String -> JUnitConfig -> JUnitConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1")
        ]

  readEnv :: String
-> (String -> JUnitConfig -> JUnitConfig)
-> JUnitConfig
-> JUnitConfig
readEnv String
name String -> JUnitConfig -> JUnitConfig
setter =
    (JUnitConfig -> JUnitConfig)
-> (String -> JUnitConfig -> JUnitConfig)
-> Maybe String
-> JUnitConfig
-> JUnitConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JUnitConfig -> JUnitConfig
forall a. a -> a
id (String -> JUnitConfig -> JUnitConfig
setter (String -> JUnitConfig -> JUnitConfig)
-> (String -> String) -> String -> JUnitConfig -> JUnitConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
replaceBase String
base) (Maybe String -> JUnitConfig -> JUnitConfig)
-> Maybe String -> JUnitConfig -> JUnitConfig
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String
envPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) [(String, String)]
env

envPrefix :: String
envPrefix :: String
envPrefix = String
"JUNIT_"

replaceBase :: String -> String -> String
replaceBase :: String -> String -> String
replaceBase String
base = Text -> String
unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"{base}" (String -> Text
pack String
base) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack