    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE NoMonomorphismRestriction #-}
    -- | Run a 'Tasty.TestTree' and produce an XML file summarising the test results
    -- in the same schema that would be produced by Apache Ant's JUnit test runner.
    -- This schema can be intepreted by the Jenkins continuous integration server,
    -- amongst other tools.
    module Test.Tasty.Runners.AntXML (antXMLRunner, AntXMLPath(..) ) where

    import Numeric (showFFloat)
    import Control.Applicative
    import Control.Arrow (first)
    import Control.Monad.IO.Class (liftIO)
    import Data.Foldable (fold)
    import Data.List (intercalate)
    import Data.Maybe (fromMaybe)
    import Data.Monoid (Monoid(..), Endo(..), Sum(..))
    import Data.Proxy (Proxy(..))
    import Data.Tagged (Tagged(..))
    import Data.Typeable (Typeable)
    import GHC.Generics (Generic)
    import Generics.Deriving.Monoid (memptydefault, mappenddefault)
    import System.Directory (createDirectoryIfMissing, canonicalizePath)
    import System.FilePath (takeDirectory)

    import qualified Control.Concurrent.STM as STM
    import qualified Control.Monad.State as State
    import qualified Control.Monad.Reader as Reader
    import qualified Data.Functor.Compose as Functor
    import qualified Data.IntMap as IntMap
    import qualified Test.Tasty as Tasty
    import qualified Test.Tasty.Providers as Tasty
    import qualified Test.Tasty.Options as Tasty
    import qualified Test.Tasty.Runners as Tasty
    import qualified Text.XML.Light as XML

    --------------------------------------------------------------------------------
    newtype AntXMLPath = AntXMLPath FilePath
      deriving (Typeable)

    instance Tasty.IsOption (Maybe AntXMLPath) where
      defaultValue :: Maybe AntXMLPath
    defaultValue = Maybe AntXMLPath
    forall a. Maybe a
    Nothing
      parseValue :: String -> Maybe (Maybe AntXMLPath)
    parseValue = Maybe AntXMLPath -> Maybe (Maybe AntXMLPath)
    forall a. a -> Maybe a
    Just (Maybe AntXMLPath -> Maybe (Maybe AntXMLPath))
    -> (String -> Maybe AntXMLPath)
    -> String
    -> Maybe (Maybe AntXMLPath)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AntXMLPath -> Maybe AntXMLPath
    forall a. a -> Maybe a
    Just (AntXMLPath -> Maybe AntXMLPath)
    -> (String -> AntXMLPath) -> String -> Maybe AntXMLPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> AntXMLPath
    AntXMLPath
      optionName :: Tagged (Maybe AntXMLPath) String
    optionName = String -> Tagged (Maybe AntXMLPath) String
    forall {k} (s :: k) b. b -> Tagged s b
    Tagged String
    "xml"
      optionHelp :: Tagged (Maybe AntXMLPath) String
    optionHelp = String -> Tagged (Maybe AntXMLPath) String
    forall {k} (s :: k) b. b -> Tagged s b
    Tagged String
    "A file path to store the test results in Ant-compatible XML"

    --------------------------------------------------------------------------------
    data Summary = Summary { Summary -> Sum Int
    summaryFailures :: Sum Int
                           , Summary -> Sum Int
    summaryErrors :: Sum Int
                           , Summary -> Sum Int
    summarySuccesses :: Sum Int
                           , Summary -> Endo [Element]
    xmlRenderer :: Endo [XML.Element]
                           } deriving ((forall x. Summary -> Rep Summary x)
    -> (forall x. Rep Summary x -> Summary) -> Generic Summary
    forall x. Rep Summary x -> Summary
    forall x. Summary -> Rep Summary x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Summary -> Rep Summary x
    from :: forall x. Summary -> Rep Summary x
    $cto :: forall x. Rep Summary x -> Summary
    to :: forall x. Rep Summary x -> Summary
    Generic)

    instance Monoid Summary where
      mempty :: Summary
    mempty = Summary
    forall a. (Generic a, Monoid' (Rep a)) => a
    memptydefault
    #if !MIN_VERSION_base(4,11,0)
      mappend = mappenddefault
    #else
    instance Semigroup Summary where
      <> :: Summary -> Summary -> Summary
    (<>) = Summary -> Summary -> Summary
    forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
    mappenddefault
    #endif

    --------------------------------------------------------------------------------
    {-|

      To run tests using this ingredient, use 'Tasty.defaultMainWithIngredients',
      passing 'antXMLRunner' as one possible ingredient. This ingredient will run
      tests if you pass the @--xml@ command line option. For example,
      @--xml=junit.xml@ will run all the tests and generate @junit.xml@ as output.

    -}
    antXMLRunner :: Tasty.Ingredient
    antXMLRunner :: Ingredient
    antXMLRunner = [OptionDescription]
    -> (OptionSet
        -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool)))
    -> Ingredient
    Tasty.TestReporter [OptionDescription]
    optionDescription OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
    forall {m :: * -> *} {a}.
    (Monad m, IsOption (m AntXMLPath), RealFloat a, Typeable m) =>
    OptionSet -> TestTree -> m (StatusMap -> IO (a -> IO Bool))
    runner
     where
      optionDescription :: [OptionDescription]
    optionDescription = [ Proxy (Maybe AntXMLPath) -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Tasty.Option (Proxy (Maybe AntXMLPath)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy (Maybe AntXMLPath)) ]
      runner :: OptionSet -> TestTree -> m (StatusMap -> IO (a -> IO Bool))
    runner OptionSet
    options TestTree
    testTree = do
        AntXMLPath String
    path <- OptionSet -> m AntXMLPath
    forall v. IsOption v => OptionSet -> v
    Tasty.lookupOption OptionSet
    options

        (StatusMap -> IO (a -> IO Bool))
    -> m (StatusMap -> IO (a -> IO Bool))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((StatusMap -> IO (a -> IO Bool))
     -> m (StatusMap -> IO (a -> IO Bool)))
    -> (StatusMap -> IO (a -> IO Bool))
    -> m (StatusMap -> IO (a -> IO Bool))
    forall a b. (a -> b) -> a -> b
    $ \StatusMap
    statusMap ->
          let
            timeDigits :: a
    timeDigits = a
    3
            showTime :: a -> String
    showTime a
    time = Maybe Int -> a -> ShowS
    forall a. RealFloat a => Maybe Int -> a -> ShowS
    showFFloat (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    forall {a}. Num a => a
    timeDigits) a
    time String
    ""

            runTest :: (Tasty.IsTest t)
                    => Tasty.OptionSet
                    -> Tasty.TestName
                    -> t
                    -> Tasty.Traversal (Functor.Compose (Reader.ReaderT [String] (State.StateT IntMap.Key IO)) (Const Summary))
            runTest :: forall t.
    IsTest t =>
    OptionSet
    -> String
    -> t
    -> Traversal
         (Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
    runTest OptionSet
    _ String
    testName t
    _ = Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    -> Traversal
         (Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
    forall (f :: * -> *). f () -> Traversal f
    Tasty.Traversal (Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
     -> Traversal
          (Compose (ReaderT [String] (StateT Int IO)) (Const Summary)))
    -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    -> Traversal
         (Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
    forall a b. (a -> b) -> a -> b
    $ ReaderT [String] (StateT Int IO) (Const Summary ())
    -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Functor.Compose (ReaderT [String] (StateT Int IO) (Const Summary ())
     -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ())
    -> ReaderT [String] (StateT Int IO) (Const Summary ())
    -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    forall a b. (a -> b) -> a -> b
    $ do
              Int
    i <- ReaderT [String] (StateT Int IO) Int
    forall s (m :: * -> *). MonadState s m => m s
    State.get
              [String]
    groupNames <- ReaderT [String] (StateT Int IO) [String]
    forall r (m :: * -> *). MonadReader r m => m r
    Reader.ask

              Summary
    summary <- IO Summary -> ReaderT [String] (StateT Int IO) Summary
    forall a. IO a -> ReaderT [String] (StateT Int IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Summary -> ReaderT [String] (StateT Int IO) Summary)
    -> IO Summary -> ReaderT [String] (StateT Int IO) Summary
    forall a b. (a -> b) -> a -> b
    $ STM Summary -> IO Summary
    forall a. STM a -> IO a
    STM.atomically (STM Summary -> IO Summary) -> STM Summary -> IO Summary
    forall a b. (a -> b) -> a -> b
    $ do
                Status
    status <- TVar Status -> STM Status
    forall a. TVar a -> STM a
    STM.readTVar (TVar Status -> STM Status) -> TVar Status -> STM Status
    forall a b. (a -> b) -> a -> b
    $
                  TVar Status -> Maybe (TVar Status) -> TVar Status
    forall a. a -> Maybe a -> a
    fromMaybe (String -> TVar Status
    forall a. HasCallStack => String -> a
    error String
    "Attempted to lookup test by index outside bounds") (Maybe (TVar Status) -> TVar Status)
    -> Maybe (TVar Status) -> TVar Status
    forall a b. (a -> b) -> a -> b
    $
                    Int -> StatusMap -> Maybe (TVar Status)
    forall a. Int -> IntMap a -> Maybe a
    IntMap.lookup Int
    i StatusMap
    statusMap

                let testCaseAttributes :: a -> [Attr]
    testCaseAttributes a
    time = ((String, String) -> Attr) -> [(String, String)] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((QName -> String -> Attr) -> (QName, String) -> Attr
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry QName -> String -> Attr
    XML.Attr ((QName, String) -> Attr)
    -> ((String, String) -> (QName, String))
    -> (String, String)
    -> Attr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> QName) -> (String, String) -> (QName, String)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first String -> QName
    XML.unqual)
                      [ (String
    "name", String
    testName)
                      , (String
    "time", a -> String
    forall {a}. RealFloat a => a -> String
    showTime a
    time)
                      , (String
    "classname", String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    groupNames))
                      ]

                    mkSummary :: t -> Summary
    mkSummary t
    contents =
                      Summary
    forall a. Monoid a => a
    mempty { xmlRenderer = Endo
                                 (XML.node (XML.unqual "testcase") contents :)
                             }

                    mkSuccess :: a -> Summary
    mkSuccess a
    time = ([Attr] -> Summary
    forall {t}. Node t => t -> Summary
    mkSummary (a -> [Attr]
    forall {a}. RealFloat a => a -> [Attr]
    testCaseAttributes a
    time)) { summarySuccesses = Sum 1 }

                    mkFailure :: a -> t -> Summary
    mkFailure a
    time t
    reason =
                      ([Attr], Element) -> Summary
    forall {t}. Node t => t -> Summary
    mkSummary ( a -> [Attr]
    forall {a}. RealFloat a => a -> [Attr]
    testCaseAttributes a
    time
                                , QName -> t -> Element
    forall t. Node t => QName -> t -> Element
    XML.node (String -> QName
    XML.unqual String
    "failure") t
    reason
                                )

                case Status
    status of
                  -- If the test is done, generate XML for it
                  Tasty.Done Result
    result
                    | Result -> Bool
    Tasty.resultSuccessful Result
    result -> Summary -> STM Summary
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Time -> Summary
    forall {a}. RealFloat a => a -> Summary
    mkSuccess (Result -> Time
    Tasty.resultTime Result
    result))
                    | Bool
    otherwise ->
                        case Result -> Maybe SomeException
    resultException Result
    result of
                          Just SomeException
    e  -> Summary -> STM Summary
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Summary -> STM Summary) -> Summary -> STM Summary
    forall a b. (a -> b) -> a -> b
    $ (Time -> String -> Summary
    forall {a} {t}. (RealFloat a, Node t) => a -> t -> Summary
    mkFailure (Result -> Time
    Tasty.resultTime Result
    result) (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)) { summaryErrors = Sum 1 }
                          Maybe SomeException
    Nothing -> Summary -> STM Summary
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Summary -> STM Summary) -> Summary -> STM Summary
    forall a b. (a -> b) -> a -> b
    $
                            if Result -> Bool
    resultTimedOut Result
    result
                              then (Time -> String -> Summary
    forall {a} {t}. (RealFloat a, Node t) => a -> t -> Summary
    mkFailure (Result -> Time
    Tasty.resultTime Result
    result) String
    "TimeOut") { summaryErrors = Sum 1 }
                              else (Time -> String -> Summary
    forall {a} {t}. (RealFloat a, Node t) => a -> t -> Summary
    mkFailure (Result -> Time
    Tasty.resultTime Result
    result) (Result -> String
    Tasty.resultDescription Result
    result))
                                   { summaryFailures = Sum 1 }

                  -- Otherwise the test has either not been started or is currently
                  -- executing
                  Status
    _ -> STM Summary
    forall a. STM a
    STM.retry

              Summary -> Const Summary ()
    forall {k} a (b :: k). a -> Const a b
    Const Summary
    summary Const Summary ()
    -> ReaderT [String] (StateT Int IO) ()
    -> ReaderT [String] (StateT Int IO) (Const Summary ())
    forall a b.
    a
    -> ReaderT [String] (StateT Int IO) b
    -> ReaderT [String] (StateT Int IO) a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Int -> Int) -> ReaderT [String] (StateT Int IO) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    State.modify (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

            runGroup
              :: Reader.MonadReader [String] f
              => String
              -> Tasty.Traversal (Functor.Compose f (Const Summary))
              -> Tasty.Traversal (Functor.Compose f (Const Summary))
            runGroup :: forall (f :: * -> *).
    MonadReader [String] f =>
    String
    -> Traversal (Compose f (Const Summary))
    -> Traversal (Compose f (Const Summary))
    runGroup String
    groupName Traversal (Compose f (Const Summary))
    children = Compose f (Const Summary) ()
    -> Traversal (Compose f (Const Summary))
    forall (f :: * -> *). f () -> Traversal f
    Tasty.Traversal (Compose f (Const Summary) ()
     -> Traversal (Compose f (Const Summary)))
    -> Compose f (Const Summary) ()
    -> Traversal (Compose f (Const Summary))
    forall a b. (a -> b) -> a -> b
    $ f (Const Summary ()) -> Compose f (Const Summary) ()
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Functor.Compose (f (Const Summary ()) -> Compose f (Const Summary) ())
    -> f (Const Summary ()) -> Compose f (Const Summary) ()
    forall a b. (a -> b) -> a -> b
    $ do
              Const Summary
    soFar <- ([String] -> [String])
    -> f (Const Summary ()) -> f (Const Summary ())
    forall a. ([String] -> [String]) -> f a -> f a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    Reader.local (String
    groupName String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :) (f (Const Summary ()) -> f (Const Summary ()))
    -> f (Const Summary ()) -> f (Const Summary ())
    forall a b. (a -> b) -> a -> b
    $ Compose f (Const Summary) () -> f (Const Summary ())
    forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
    Compose f g a -> f (g a)
    Functor.getCompose (Compose f (Const Summary) () -> f (Const Summary ()))
    -> Compose f (Const Summary) () -> f (Const Summary ())
    forall a b. (a -> b) -> a -> b
    $ Traversal (Compose f (Const Summary))
    -> Compose f (Const Summary) ()
    forall (f :: * -> *). Traversal f -> f ()
    Tasty.getTraversal Traversal (Compose f (Const Summary))
    children

              let grouped :: Element
    grouped =
                    QName -> ([Attr], [Element]) -> Element
    forall t. Node t => QName -> t -> Element
    XML.node (String -> QName
    XML.unqual String
    "testsuite")
                      ([ QName -> String -> Attr
    XML.Attr (String -> QName
    XML.unqual String
    "name") String
    groupName
                       , QName -> String -> Attr
    XML.Attr (String -> QName
    XML.unqual String
    "tests")
                           (Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> (Summary -> Int) -> Summary -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sum Int -> Int
    forall a. Sum a -> a
    getSum (Sum Int -> Int) -> (Summary -> Sum Int) -> Summary -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Summary -> Sum Int
    summaryFailures (Summary -> Sum Int) -> (Summary -> Sum Int) -> Summary -> Sum Int
    forall a. Monoid a => a -> a -> a
    `mappend` Summary -> Sum Int
    summaryErrors (Summary -> Sum Int) -> (Summary -> Sum Int) -> Summary -> Sum Int
    forall a. Monoid a => a -> a -> a
    `mappend` Summary -> Sum Int
    summarySuccesses) (Summary -> String) -> Summary -> String
    forall a b. (a -> b) -> a -> b
    $ Summary
    soFar)
                       ]
                      , Endo [Element] -> [Element] -> [Element]
    forall a. Endo a -> a -> a
    appEndo (Summary -> Endo [Element]
    xmlRenderer Summary
    soFar) []
                      )

              Const Summary () -> f (Const Summary ())
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Const Summary () -> f (Const Summary ()))
    -> Const Summary () -> f (Const Summary ())
    forall a b. (a -> b) -> a -> b
    $ Summary -> Const Summary ()
    forall {k} a (b :: k). a -> Const a b
    Const
                Summary
    soFar { xmlRenderer = Endo (grouped :)
                      }

            runGroup' :: p
    -> String
    -> Traversal (Compose f (Const Summary))
    -> Traversal (Compose f (Const Summary))
    runGroup' p
    _options String
    groupName =
    #if MIN_VERSION_tasty(1, 5, 0)
              runGroup groupName . fold
    #else
              String
    -> Traversal (Compose f (Const Summary))
    -> Traversal (Compose f (Const Summary))
    forall (f :: * -> *).
    MonadReader [String] f =>
    String
    -> Traversal (Compose f (Const Summary))
    -> Traversal (Compose f (Const Summary))
    runGroup String
    groupName
    #endif

          in do
            (Const Summary
    summary, Int
    tests) <-
              (StateT Int IO (Const Summary ())
     -> Int -> IO (Const Summary (), Int))
    -> Int
    -> StateT Int IO (Const Summary ())
    -> IO (Const Summary (), Int)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT Int IO (Const Summary ())
    -> Int -> IO (Const Summary (), Int)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    State.runStateT Int
    0 (StateT Int IO (Const Summary ()) -> IO (Const Summary (), Int))
    -> StateT Int IO (Const Summary ()) -> IO (Const Summary (), Int)
    forall a b. (a -> b) -> a -> b
    $ (ReaderT [String] (StateT Int IO) (Const Summary ())
     -> [String] -> StateT Int IO (Const Summary ()))
    -> [String]
    -> ReaderT [String] (StateT Int IO) (Const Summary ())
    -> StateT Int IO (Const Summary ())
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT [String] (StateT Int IO) (Const Summary ())
    -> [String] -> StateT Int IO (Const Summary ())
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    Reader.runReaderT [] (ReaderT [String] (StateT Int IO) (Const Summary ())
     -> StateT Int IO (Const Summary ()))
    -> ReaderT [String] (StateT Int IO) (Const Summary ())
    -> StateT Int IO (Const Summary ())
    forall a b. (a -> b) -> a -> b
    $ Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    -> ReaderT [String] (StateT Int IO) (Const Summary ())
    forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
    Compose f g a -> f (g a)
    Functor.getCompose (Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
     -> ReaderT [String] (StateT Int IO) (Const Summary ()))
    -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    -> ReaderT [String] (StateT Int IO) (Const Summary ())
    forall a b. (a -> b) -> a -> b
    $ Traversal
      (Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
    -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    forall (f :: * -> *). Traversal f -> f ()
    Tasty.getTraversal (Traversal
       (Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
     -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ())
    -> Traversal
         (Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
    -> Compose (ReaderT [String] (StateT Int IO)) (Const Summary) ()
    forall a b. (a -> b) -> a -> b
    $
               TreeFold
      (Traversal
         (Compose (ReaderT [String] (StateT Int IO)) (Const Summary)))
    -> OptionSet
    -> TestTree
    -> Traversal
         (Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
    forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
    Tasty.foldTestTree
                 TreeFold
      (Traversal
         (Compose (ReaderT [String] (StateT Int IO)) (Const Summary)))
    forall b. Monoid b => TreeFold b
    Tasty.trivialFold { Tasty.foldSingle = runTest, Tasty.foldGroup = runGroup' }
                 OptionSet
    options
                 TestTree
    testTree

            (a -> IO Bool) -> IO (a -> IO Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((a -> IO Bool) -> IO (a -> IO Bool))
    -> (a -> IO Bool) -> IO (a -> IO Bool)
    forall a b. (a -> b) -> a -> b
    $ \a
    elapsedTime -> do
              String -> IO ()
    createPathDirIfMissing String
    path
              String -> String -> IO ()
    writeFile String
    path (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Element -> String
    XML.showTopElement (Element -> String) -> Element -> String
    forall a b. (a -> b) -> a -> b
    $
                  QName -> ([Attr], [Element]) -> Element
    forall t. Node t => QName -> t -> Element
    XML.node
                    (String -> QName
    XML.unqual String
    "testsuites")
                    ([ QName -> String -> Attr
    XML.Attr (String -> QName
    XML.unqual String
    "errors")
                         (Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> (Summary -> Int) -> Summary -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sum Int -> Int
    forall a. Sum a -> a
    getSum (Sum Int -> Int) -> (Summary -> Sum Int) -> Summary -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Summary -> Sum Int
    summaryErrors (Summary -> String) -> Summary -> String
    forall a b. (a -> b) -> a -> b
    $ Summary
    summary)
                     , QName -> String -> Attr
    XML.Attr (String -> QName
    XML.unqual String
    "failures")
                         (Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> (Summary -> Int) -> Summary -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sum Int -> Int
    forall a. Sum a -> a
    getSum (Sum Int -> Int) -> (Summary -> Sum Int) -> Summary -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Summary -> Sum Int
    summaryFailures (Summary -> String) -> Summary -> String
    forall a b. (a -> b) -> a -> b
    $ Summary
    summary)
                     , QName -> String -> Attr
    XML.Attr (String -> QName
    XML.unqual String
    "tests") (Int -> String
    forall a. Show a => a -> String
    show Int
    tests)
                     , QName -> String -> Attr
    XML.Attr (String -> QName
    XML.unqual String
    "time") (a -> String
    forall {a}. RealFloat a => a -> String
    showTime a
    elapsedTime)
                     ]
                    , Endo [Element] -> [Element] -> [Element]
    forall a. Endo a -> a -> a
    appEndo (Summary -> Endo [Element]
    xmlRenderer Summary
    summary) [])

              Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Sum Int -> Int
    forall a. Sum a -> a
    getSum ((Summary -> Sum Int
    summaryFailures (Summary -> Sum Int) -> (Summary -> Sum Int) -> Summary -> Sum Int
    forall a. Monoid a => a -> a -> a
    `mappend` Summary -> Sum Int
    summaryErrors) Summary
    summary) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0)

      resultException :: Result -> Maybe SomeException
    resultException Result
    r =
        case Result -> Outcome
    Tasty.resultOutcome Result
    r of
             Tasty.Failure (Tasty.TestThrewException SomeException
    e) -> SomeException -> Maybe SomeException
    forall a. a -> Maybe a
    Just SomeException
    e
             Outcome
    _ -> Maybe SomeException
    forall a. Maybe a
    Nothing

      resultTimedOut :: Result -> Bool
    resultTimedOut Result
    r =
        case Result -> Outcome
    Tasty.resultOutcome Result
    r of
             Tasty.Failure (Tasty.TestTimedOut Integer
    _) -> Bool
    True
             Outcome
    _ -> Bool
    False

      createPathDirIfMissing :: String -> IO ()
    createPathDirIfMissing String
    path = ShowS -> IO String -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ShowS
    takeDirectory (String -> IO String
    canonicalizePath String
    path)
                                    IO String -> (String -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True