    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
    ""
                        ]