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
  String
host <- IO String
getHostName
  ZonedTime
theTime <- IO ZonedTime
getZonedTime
  RunDescription -> IO RunDescription
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RunDescription {
            errors :: Int
errors = Int
0                  -- not yet available
          , failedCount :: Int
failedCount = TestCount -> Int
testCountTotal (TestStatistics -> TestCount
ts_failed_tests TestStatistics
test_statistics) -- this includes errors
          , skipped :: Maybe Int
skipped = Maybe Int
forall a. Maybe a
Nothing           -- not yet applicable
          , hostname :: Maybe String
hostname = String -> Maybe String
forall a. a -> Maybe a
Just String
host
          , suiteName :: String
suiteName = String
"test-framework tests" -- not yet available
          , testCount :: Int
testCount = TestCount -> Int
testCountTotal (TestStatistics -> TestCount
ts_total_tests TestStatistics
test_statistics)
          , time :: Double
time = Double
0.0                  -- We don't currently measure the test run time.
          , timeStamp :: Maybe String
timeStamp = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%a %B %e %k:%M:%S %Z %Y" ZonedTime
theTime -- e.g. Thu May  6 22:09:10 BST 2010
          , runId :: Maybe String
runId = Maybe String
forall a. Maybe a
Nothing             -- not applicable
          , package :: Maybe String
package = Maybe String
forall a. Maybe a
Nothing           -- not yet available
          , tests :: [FinishedTest]
tests = [FinishedTest]
fin_tests
          }