{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
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.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
$cto :: forall x. Rep Summary x -> Summary
$cfrom :: forall x. Summary -> Rep Summary x
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
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) =>
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 (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 :: p
timeDigits = p
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 p. Num p => p
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 :: 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 (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 (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 [Element]
xmlRenderer = ([Element] -> [Element]) -> Endo [Element]
forall a. (a -> a) -> Endo a
Endo
(QName -> t -> Element
forall t. Node t => QName -> t -> Element
XML.node (String -> QName
XML.unqual String
"testcase") t
contents Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:)
}
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 Int
summarySuccesses = Int -> Sum Int
forall a. a -> Sum a
Sum Int
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
Tasty.Done Result
result
| Result -> Bool
Tasty.resultSuccessful Result
result -> Summary -> STM Summary
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 (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 Int
summaryErrors = Int -> Sum Int
forall a. a -> Sum a
Sum Int
1 }
Maybe SomeException
Nothing -> Summary -> STM Summary
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 Int
summaryErrors = Int -> Sum Int
forall a. a -> Sum a
Sum Int
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 Int
summaryFailures = Int -> Sum Int
forall a. a -> Sum a
Sum Int
1 }
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 (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 :: p
-> String
-> Traversal (Compose f (Const Summary))
-> Traversal (Compose f (Const Summary))
runGroup p
_options 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 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 (f :: k1 -> *) k2 (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 (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 [Element]
xmlRenderer = ([Element] -> [Element]) -> Endo [Element]
forall a. (a -> a) -> Endo a
Endo (Element
grouped Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:)
}
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 (f :: k1 -> *) k2 (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 { foldSingle :: forall t.
IsTest t =>
OptionSet
-> String
-> t
-> Traversal
(Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
Tasty.foldSingle = forall t.
IsTest t =>
OptionSet
-> String
-> t
-> Traversal
(Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
runTest, foldGroup :: OptionSet
-> String
-> Traversal
(Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
-> Traversal
(Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
Tasty.foldGroup = OptionSet
-> String
-> Traversal
(Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
-> Traversal
(Compose (ReaderT [String] (StateT Int IO)) (Const Summary))
forall (f :: * -> *) p.
MonadReader [String] f =>
p
-> String
-> Traversal (Compose f (Const Summary))
-> Traversal (Compose f (Const Summary))
runGroup }
OptionSet
options
TestTree
testTree
(a -> IO Bool) -> IO (a -> IO Bool)
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 (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> String -> IO ()
createDirectoryIfMissing Bool
True