module Test.Framework.Runners.XML (
        produceReport
    ) where

import Test.Framework.Runners.Statistics       ( testCountTotal, TestStatistics(..) )
import Test.Framework.Runners.Core             ( FinishedTest )
import Test.Framework.Runners.XML.JUnitWriter  ( RunDescription(..), serialize )

import Data.Time.Format    ( formatTime )
import Data.Time.LocalTime ( getZonedTime )
import Data.Time.Format    ( defaultTimeLocale )

import Network.HostName    ( getHostName )


produceReport :: Bool -> TestStatistics -> [FinishedTest] -> IO String
produceReport :: Bool -> TestStatistics -> [FinishedTest] -> IO String
produceReport Bool
nested TestStatistics
test_statistics [FinishedTest]
fin_tests = (RunDescription -> String) -> IO RunDescription -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> RunDescription -> String
serialize Bool
nested) (IO RunDescription -> IO String) -> IO RunDescription -> IO String
forall a b. (a -> b) -> a -> b
$ TestStatistics -> [FinishedTest] -> IO RunDescription
mergeResults TestStatistics
test_statistics [FinishedTest]
fin_tests


-- | Generates a description of the complete test run, given some
-- initial over-all test statistics and the list of tests that was
-- run.
--
-- This is only specific to the XML code because the console output
-- @Runner@ doesn't need this level of detail to produce summary
-- information, and the per-test details are generated during
-- execution.
--
-- This could be done better by using a State monad in the notifier
-- defined within `issueTests`.
mergeResults :: TestStatistics -> [FinishedTest] -> IO RunDescription
mergeResults :: TestStatistics -> [FinishedTest] -> IO RunDescription
mergeResults TestStatistics
test_statistics [FinishedTest]
fin_tests = do
  host <- IO String
getHostName
  theTime <- getZonedTime
  return RunDescription {
            errors = 0                  -- not yet available
          , failedCount = testCountTotal (ts_failed_tests test_statistics) -- this includes errors
          , skipped = Nothing           -- not yet applicable
          , hostname = Just host
          , suiteName = "test-framework tests" -- not yet available
          , testCount = testCountTotal (ts_total_tests test_statistics)
          , time = 0.0                  -- We don't currently measure the test run time.
          , timeStamp = Just $ formatTime defaultTimeLocale "%a %B %e %k:%M:%S %Z %Y" theTime -- e.g. Thu May  6 22:09:10 BST 2010
          , runId = Nothing             -- not applicable
          , package = Nothing           -- not yet available
          , tests = fin_tests
          }