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 [Char]
hostname :: Maybe String  -- ^ The hostname that ran the test suite.
  , RunDescription -> [Char]
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 [Char]
timeStamp :: Maybe String -- ^ The time stamp that identifies when this run happened.
  , RunDescription -> Maybe [Char]
runId :: Maybe String     -- ^ Included for completness w/ junit.
  , RunDescription -> Maybe [Char]
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 -> [Char]
(Int -> RunDescription -> ShowS)
-> (RunDescription -> [Char])
-> ([RunDescription] -> ShowS)
-> Show RunDescription
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunDescription -> ShowS
showsPrec :: Int -> RunDescription -> ShowS
$cshow :: RunDescription -> [Char]
show :: RunDescription -> [Char]
$cshowList :: [RunDescription] -> ShowS
showList :: [RunDescription] -> ShowS
Show)


-- | Serializes a `RunDescription` value to a `String`.
serialize :: Bool -> RunDescription -> String
serialize :: Bool -> RunDescription -> [Char]
serialize Bool
nested = Element -> [Char]
ppTopElement (Element -> [Char])
-> (RunDescription -> Element) -> RunDescription -> [Char]
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 = [Char] -> ([Attr], [Element]) -> Element
forall t. Node t => [Char] -> t -> Element
unode [Char]
"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 ([[Char]] -> FinishedTest -> [Element]
morphFlatTestCase [])

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

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

morphNestedTestCase :: FinishedTest -> Element
morphNestedTestCase :: FinishedTest -> Element
morphNestedTestCase (RunTestGroup [Char]
gname [FinishedTest]
testList) =
  [Char] -> ([Attr], [Element]) -> Element
forall t. Node t => [Char] -> t -> Element
unode [Char]
"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 -> [Char] -> Attr
Attr ([Char] -> QName
unqual [Char]
"name") [Char]
gname ]
morphNestedTestCase (RunTest [Char]
tName [Char]
_ ([Char], Bool)
res) = [Char] -> [Char] -> ([Char], Bool) -> Element
morphOneTestCase [Char]
"" [Char]
tName ([Char], Bool)
res

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