-- | An Hspec formatter that produces a JUnit XML file of results
--
-- @
-- -- file test/SpecHook.hs
-- module SpecHook where
--
-- import Test.Hspec
-- import Test.Hspec.JUnit.Config
-- import Test.Hspec.JUnit.Formatter qualified as Formatter
--
-- -- | To only produce a JUnit file, silencing other output
-- hook :: Spec -> Spec
-- hook = Formatter.use defaultJUnitConfig
--
-- -- | To produce a JUnit file /in addition/ to the normal output
-- hook :: Spec -> Spec
-- hook = Formatter.add defaultJUnitConfig
--
-- -- | To only produce, but only when @--format=junit@ is used
-- hook :: Spec -> Spec
-- hook = Formatter.register defaultJUnitConfig
-- @
--
-- See also,
--
-- - https://hspec.github.io/hspec-discover.html#spec-hooks
-- - https://hspec.github.io/extending-hspec-formatter.html#packaging-a-formatter-for-distribution-and-reuse
--
-- For a version that reads configuration from @JUNIT_@ environment variables,
-- see "Test.Hspec.JUnit.Formatter.Env".
module Test.Hspec.JUnit.Formatter
  ( use
  , add
  , register
  , formatter
  , module Test.Hspec.JUnit.Config
  , module Api
  ) where

import Prelude

import Data.Maybe (fromMaybe)

import Test.Hspec.Api.Format.V1 as Api
import qualified Test.Hspec.Core.Format as Core
import qualified Test.Hspec.Core.Formatters.V2 as V2
import Test.Hspec.Core.Runner as Core (Config (..))
import Test.Hspec.JUnit.Config
import Test.Hspec.JUnit.Format

-- | Register 'junit' as an available formatter and use it by default
use :: JUnitConfig -> SpecWith a -> SpecWith a
use :: forall a. JUnitConfig -> SpecWith a -> SpecWith a
use JUnitConfig
config = ((Config -> Config) -> SpecWith a
forall a. (Config -> Config) -> SpecWith a
modifyConfig ((String, FormatConfig -> IO Format) -> Config -> Config
useFormatter ((String, FormatConfig -> IO Format) -> Config -> Config)
-> (String, FormatConfig -> IO Format) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ JUnitConfig -> (String, FormatConfig -> IO Format)
formatter JUnitConfig
config) SpecWith a -> SpecWith a -> SpecWith a
forall a b. SpecM a a -> SpecM a b -> SpecM a b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)

-- | Register 'junit', and use it /in addition/ to the default
add :: JUnitConfig -> SpecWith a -> SpecWith a
add :: forall a. JUnitConfig -> SpecWith a -> SpecWith a
add JUnitConfig
config = ((Config -> Config) -> SpecWith a
forall a. (Config -> Config) -> SpecWith a
modifyConfig ((String, FormatConfig -> IO Format) -> Config -> Config
addFormatter ((String, FormatConfig -> IO Format) -> Config -> Config)
-> (String, FormatConfig -> IO Format) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ JUnitConfig -> (String, FormatConfig -> IO Format)
formatter JUnitConfig
config) SpecWith a -> SpecWith a -> SpecWith a
forall a b. SpecM a a -> SpecM a b -> SpecM a b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)

-- | Register 'junit', but do not change the default
register :: JUnitConfig -> SpecWith a -> SpecWith a
register :: forall a. JUnitConfig -> SpecWith a -> SpecWith a
register JUnitConfig
config = ((Config -> Config) -> SpecWith a
forall a. (Config -> Config) -> SpecWith a
modifyConfig ((String, FormatConfig -> IO Format) -> Config -> Config
registerFormatter ((String, FormatConfig -> IO Format) -> Config -> Config)
-> (String, FormatConfig -> IO Format) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ JUnitConfig -> (String, FormatConfig -> IO Format)
formatter JUnitConfig
config) SpecWith a -> SpecWith a -> SpecWith a
forall a b. SpecM a a -> SpecM a b -> SpecM a b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)

formatter :: JUnitConfig -> (String, FormatConfig -> IO Format)
formatter :: JUnitConfig -> (String, FormatConfig -> IO Format)
formatter JUnitConfig
config = (String
"junit", JUnitConfig -> FormatConfig -> IO Format
junit JUnitConfig
config)

addFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
addFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
addFormatter (String, FormatConfig -> IO Format)
f = Config -> Config
go (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FormatConfig -> IO Format) -> Config -> Config
registerFormatter (String, FormatConfig -> IO Format)
f
 where
  go :: Config -> Config
go Config
config =
    Config
config
      { configFormat =
          Just
            . (`addFormat` format)
            . fromMaybe defaultFormat
            $ configFormat config
      }

  format :: FormatConfig -> IO Format
format = (String, FormatConfig -> IO Format) -> FormatConfig -> IO Format
forall a b. (a, b) -> b
snd ((String, FormatConfig -> IO Format) -> FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format) -> FormatConfig -> IO Format
forall a b. (a -> b) -> a -> b
$ (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
liftFormatter (String, FormatConfig -> IO Format)
f

defaultFormat :: Core.FormatConfig -> IO Core.Format
defaultFormat :: FormatConfig -> IO Format
defaultFormat = Formatter -> FormatConfig -> IO Format
V2.formatterToFormat Formatter
V2.checks

addFormat
  :: (Core.FormatConfig -> IO Core.Format)
  -> (Core.FormatConfig -> IO Core.Format)
  -> Core.FormatConfig
  -> IO Core.Format
addFormat :: (FormatConfig -> IO Format)
-> (FormatConfig -> IO Format) -> FormatConfig -> IO Format
addFormat FormatConfig -> IO Format
f1 FormatConfig -> IO Format
f2 FormatConfig
fc = do
  Format
formatEvent1 <- FormatConfig -> IO Format
f1 FormatConfig
fc
  Format
formatEvent2 <- FormatConfig -> IO Format
f2 FormatConfig
fc
  Format -> IO Format
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Format -> IO Format) -> Format -> IO Format
forall a b. (a -> b) -> a -> b
$ \Event
event -> do
    Format
formatEvent1 Event
event
    Format
formatEvent2 Event
event