module Test.Framework.Runners.XML.JUnitWriter (
        RunDescription(..),
        serialize,
#ifdef TEST
        morphFlatTestCase, morphNestedTestCase
#endif
    ) where

import Test.Framework.Core (TestName)
import Test.Framework.Runners.Core (RunTest(..), FinishedTest)

import Data.List  ( intercalate )
import Data.Maybe ( fromMaybe )
import Text.XML.Light ( ppTopElement, unqual, unode
                      , Attr(..), Element(..) )


-- | An overall description of the test suite run.  This is currently
-- styled after the JUnit xml.  It contains records that are not yet
-- used, however, it provides a sensible structure to populate as we
-- are able, and the serialization code behaves as though these are
-- filled.
data RunDescription = RunDescription {
    RunDescription -> Int
errors :: Int -- ^ The number of tests that triggered error
                  -- conditions (unanticipated failures)
  , RunDescription -> Int
failedCount :: Int        -- ^ Count of tests that invalidated stated assertions.
  , RunDescription -> Maybe Int
skipped :: Maybe Int      -- ^ Count of tests that were provided but not run.
  , RunDescription -> Maybe String
hostname :: Maybe String  -- ^ The hostname that ran the test suite.
  , RunDescription -> String
suiteName :: String       -- ^ The name of the test suite.
  , RunDescription -> Int
testCount :: Int          -- ^ The total number of tests provided.
  , RunDescription -> Double
time :: Double            -- ^ The total execution time for the test suite.
  , RunDescription -> Maybe String
timeStamp :: Maybe String -- ^ The time stamp that identifies when this run happened.
  , RunDescription -> Maybe String
runId :: Maybe String     -- ^ Included for completness w/ junit.
  , RunDescription -> Maybe String
package :: Maybe String   -- ^ holdover from Junit spec. Could be
                              -- used to specify the module under test.
  , RunDescription -> [FinishedTest]
tests :: [FinishedTest]   -- ^ detailed description and results for each test run.
  } deriving (Int -> RunDescription -> ShowS
[RunDescription] -> ShowS
RunDescription -> String
(Int -> RunDescription -> ShowS)
-> (RunDescription -> String)
-> ([RunDescription] -> ShowS)
-> Show RunDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunDescription -> ShowS
showsPrec :: Int -> RunDescription -> ShowS
$cshow :: RunDescription -> String
show :: RunDescription -> String
$cshowList :: [RunDescription] -> ShowS
showList :: [RunDescription] -> ShowS
Show)


-- | Serializes a `RunDescription` value to a `String`.
serialize :: Bool -> RunDescription -> String
serialize :: Bool -> RunDescription -> String
serialize Bool
nested = Element -> String
ppTopElement (Element -> String)
-> (RunDescription -> Element) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RunDescription -> Element
toXml Bool
nested

-- | Maps a `RunDescription` value to an XML Element
toXml :: Bool -> RunDescription -> Element
toXml :: Bool -> RunDescription -> Element
toXml Bool
nested RunDescription
runDesc = String -> ([Attr], [Element]) -> Element
forall t. Node t => String -> t -> Element
unode String
"testsuite" ([Attr]
attrs, [FinishedTest] -> [Element]
morph_cases (RunDescription -> [FinishedTest]
tests RunDescription
runDesc))
  where
    morph_cases :: [FinishedTest] -> [Element]
morph_cases | Bool
nested    = (FinishedTest -> Element) -> [FinishedTest] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map FinishedTest -> Element
morphNestedTestCase
                | Bool
otherwise = (FinishedTest -> [Element]) -> [FinishedTest] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> FinishedTest -> [Element]
morphFlatTestCase [])

    -- | Top-level attributes for the first @testsuite@ tag.
    attrs :: [Attr]
    attrs :: [Attr]
attrs = ((String, RunDescription -> String) -> Attr)
-> [(String, RunDescription -> String)] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,RunDescription -> String
f)->QName -> String -> Attr
Attr (String -> QName
unqual String
x) (RunDescription -> String
f RunDescription
runDesc)) [(String, RunDescription -> String)]
fields
    fields :: [(String, RunDescription -> String)]
fields = [ (String
"errors",    Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> (RunDescription -> Int) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Int
errors)
             , (String
"failures",  Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> (RunDescription -> Int) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Int
failedCount)
             , (String
"skipped",   String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (RunDescription -> Maybe String) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> Maybe Int -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> String
forall a. Show a => a -> String
show (Maybe Int -> Maybe String)
-> (RunDescription -> Maybe Int) -> RunDescription -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Maybe Int
skipped)
             , (String
"hostname",  String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (RunDescription -> Maybe String) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Maybe String
hostname)
             , (String
"name",      ShowS
forall a. a -> a
id ShowS -> (RunDescription -> String) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> String
suiteName)
             , (String
"tests",     Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> (RunDescription -> Int) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Int
testCount)
             , (String
"time",      Double -> String
forall a. Show a => a -> String
show (Double -> String)
-> (RunDescription -> Double) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Double
time)
             , (String
"timestamp", String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (RunDescription -> Maybe String) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Maybe String
timeStamp)
             , (String
"id",        String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (RunDescription -> Maybe String) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Maybe String
runId)
             , (String
"package",   String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (RunDescription -> Maybe String) -> RunDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunDescription -> Maybe String
package)
             ]

morphFlatTestCase :: [String] -> FinishedTest -> [Element]
morphFlatTestCase :: [String] -> FinishedTest -> [Element]
morphFlatTestCase [String]
path (RunTestGroup String
gname [FinishedTest]
testList)
  = (FinishedTest -> [Element]) -> [FinishedTest] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> FinishedTest -> [Element]
morphFlatTestCase (String
gnameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path)) [FinishedTest]
testList
morphFlatTestCase [String]
path (RunTest String
tName String
_ (String, Bool)
res) = [String -> String -> (String, Bool) -> Element
morphOneTestCase String
cName String
tName (String, Bool)
res]
  where cName :: String
cName | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
path = String
"<none>"
              | Bool
otherwise = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
path)

morphNestedTestCase :: FinishedTest -> Element
morphNestedTestCase :: FinishedTest -> Element
morphNestedTestCase (RunTestGroup String
gname [FinishedTest]
testList) =
  String -> ([Attr], [Element]) -> Element
forall t. Node t => String -> t -> Element
unode String
"testsuite" ([Attr]
attrs, (FinishedTest -> Element) -> [FinishedTest] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map FinishedTest -> Element
morphNestedTestCase [FinishedTest]
testList)
  where attrs :: [Attr]
attrs = [ QName -> String -> Attr
Attr (String -> QName
unqual String
"name") String
gname ]
morphNestedTestCase (RunTest String
tName String
_ (String, Bool)
res) = String -> String -> (String, Bool) -> Element
morphOneTestCase String
"" String
tName (String, Bool)
res

morphOneTestCase :: String -> TestName -> (String, Bool) -> Element
morphOneTestCase :: String -> String -> (String, Bool) -> Element
morphOneTestCase String
cName String
tName (String
tout, Bool
pass) = case Bool
pass of
  Bool
True  -> String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode String
"testcase" [Attr]
caseAttrs
  Bool
False -> String -> ([Attr], Element) -> Element
forall t. Node t => String -> t -> Element
unode String
"testcase" ([Attr]
caseAttrs, String -> ([Attr], String) -> Element
forall t. Node t => String -> t -> Element
unode String
"failure" ([Attr]
failAttrs, String
tout))
  where caseAttrs :: [Attr]
caseAttrs = [ QName -> String -> Attr
Attr (String -> QName
unqual String
"name") String
tName
                    , QName -> String -> Attr
Attr (String -> QName
unqual String
"classname") String
cName
                    , QName -> String -> Attr
Attr (String -> QName
unqual String
"time") String
""
                    ]
        failAttrs :: [Attr]
failAttrs = [ QName -> String -> Attr
Attr (String -> QName
unqual String
"message") String
""
                    , QName -> String -> Attr
Attr (String -> QName
unqual String
"type") String
""
                    ]