{-# LANGUAGE CPP #-}
module Test.Tasty.Hspec
(
testSpec,
testSpecs,
TreatPendingAs (..),
)
where
import Control.Monad (guard)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Proxy
import Data.Typeable (Typeable)
import qualified Test.Hspec as Hspec
import qualified Test.Hspec.Core.Formatters as Hspec.Core.Formatters
import qualified Test.Hspec.Core.Spec as Hspec.Core.Spec
import qualified Test.Tasty as Tasty
import Test.Tasty.Hspec.Compat
import qualified Test.Tasty.Options as Tasty.Options
import qualified Test.Tasty.Providers as Tasty.Providers
import qualified Test.Tasty.QuickCheck as TQC
import qualified Test.Tasty.Runners as Tasty.Runners
import qualified Test.Tasty.SmallCheck as TSC
testSpec :: Tasty.TestName -> Hspec.Spec -> IO Tasty.TestTree
testSpec :: TestName -> Spec -> IO TestTree
testSpec TestName
name Spec
spec = do
[TestTree]
trees <- Spec -> IO [TestTree]
testSpecs Spec
spec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestName -> [TestTree] -> TestTree
Tasty.testGroup TestName
name [TestTree]
trees)
testSpecs :: Hspec.Spec -> IO [Tasty.TestTree]
testSpecs :: Spec -> IO [TestTree]
testSpecs Spec
spec = do
[SpecTree ()]
trees <- forall a. SpecWith a -> IO [SpecTree a]
runSpecM (Spec -> Spec
focus Spec
spec)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SpecTree () -> Maybe TestTree
specTreeToTestTree [SpecTree ()]
trees)
specTreeToTestTree :: Hspec.Core.Spec.SpecTree () -> Maybe Tasty.TestTree
specTreeToTestTree :: SpecTree () -> Maybe TestTree
specTreeToTestTree = \case
Node TestName
name [SpecTree ()]
trees -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestName -> [TestTree] -> TestTree
Tasty.testGroup TestName
name (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SpecTree () -> Maybe TestTree
specTreeToTestTree [SpecTree ()]
trees))
NodeWithCleanup IO ()
cleanup [SpecTree ()]
trees -> do
TestTree
tree <- SpecTree () -> Maybe TestTree
specTreeToTestTree (forall c a. TestName -> [Tree c a] -> Tree c a
Node TestName
"(unnamed)" [SpecTree ()]
trees)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. ResourceSpec a -> (IO a -> TestTree) -> TestTree
Tasty.Runners.WithResource (forall a. IO a -> (a -> IO ()) -> ResourceSpec a
Tasty.Runners.ResourceSpec (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> () -> IO ()
twiddleCleanup IO ()
cleanup)) (forall a b. a -> b -> a
const TestTree
tree))
Leaf Item ()
item -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Item a -> Bool
itemIsFocused Item ()
item)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall t. IsTest t => TestName -> t -> TestTree
Tasty.Providers.singleTest (forall a. Item a -> TestName
Hspec.Core.Spec.itemRequirement Item ()
item) (Item () -> Item
Item Item ()
item))
newtype Item
= Item (Hspec.Core.Spec.Item ())
deriving (Typeable)
instance Tasty.Providers.IsTest Item where
run :: OptionSet -> Item -> (Progress -> IO ()) -> IO Result
run OptionSet
opts (Item Item ()
item) Progress -> IO ()
progress = do
Args
qcArgs <- OptionSet -> IO Args
optionSetToQuickCheckArgs OptionSet
opts
let params :: Params
params =
Hspec.Core.Spec.Params
{ paramsQuickCheckArgs :: Args
Hspec.Core.Spec.paramsQuickCheckArgs = Args
qcArgs,
paramsSmallCheckDepth :: Maybe Int
Hspec.Core.Spec.paramsSmallCheckDepth = OptionSet -> Maybe Int
optionSetToSmallCheckDepth OptionSet
opts
}
Hspec.Core.Spec.Result TestName
_ ResultStatus
result <- forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item ()
item Params
params (forall a b. (a -> b) -> a -> b
$ ()) forall {a} {a}. (Integral a, Integral a) => (a, a) -> IO ()
progress'
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( case ResultStatus
result of
ResultStatus
Hspec.Core.Spec.Success -> TestName -> Result
Tasty.Providers.testPassed TestName
""
Hspec.Core.Spec.Pending Maybe Location
_ Maybe TestName
reason ->
case forall v. IsOption v => OptionSet -> v
Tasty.Options.lookupOption OptionSet
opts of
TreatPendingAs
TreatPendingAsFailure -> TestName -> Result
Tasty.Providers.testFailed TestName
reason'
TreatPendingAs
TreatPendingAsSuccess -> TestName -> Result
Tasty.Providers.testPassed TestName
reason'
where
reason' :: TestName
reason' = TestName
"# PENDING: " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe TestName
"No reason given" Maybe TestName
reason
Hspec.Core.Spec.Failure Maybe Location
_ FailureReason
reason ->
case FailureReason
reason of
FailureReason
Hspec.Core.Spec.NoReason -> TestName -> Result
Tasty.Providers.testFailed TestName
""
Hspec.Core.Spec.Reason TestName
x -> TestName -> Result
Tasty.Providers.testFailed TestName
x
Hspec.Core.Spec.ExpectedButGot Maybe TestName
preface TestName
expected TestName
actual ->
TestName -> Result
Tasty.Providers.testFailed forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestName] -> TestName
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
[ Maybe TestName
preface,
forall a. a -> Maybe a
Just (TestName
"expected: " forall a. [a] -> [a] -> [a]
++ TestName
expected),
forall a. a -> Maybe a
Just (TestName
" but got: " forall a. [a] -> [a] -> [a]
++ TestName
actual)
]
Hspec.Core.Spec.Error Maybe TestName
_ SomeException
exception ->
TestName -> Result
Tasty.Providers.testFailed (TestName
"uncaught exception: " forall a. [a] -> [a] -> [a]
++ SomeException -> TestName
Hspec.Core.Formatters.formatException SomeException
exception)
)
where
progress' :: (a, a) -> IO ()
progress' (a
x, a
y) =
Progress -> IO ()
progress
Tasty.Runners.Progress
{ progressText :: TestName
Tasty.Runners.progressText = TestName
"",
progressPercent :: Float
Tasty.Runners.progressPercent = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y
}
testOptions :: Tagged Item [OptionDescription]
testOptions =
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TreatPendingAs),
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TQC.QuickCheckTests),
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TQC.QuickCheckReplay),
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TQC.QuickCheckMaxSize),
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TQC.QuickCheckMaxRatio),
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy TSC.SmallCheckDepth)
]
data TreatPendingAs
=
TreatPendingAsFailure
| TreatPendingAsSuccess
instance Tasty.Options.IsOption TreatPendingAs where
defaultValue :: TreatPendingAs
defaultValue =
TreatPendingAs
TreatPendingAsFailure
parseValue :: TestName -> Maybe TreatPendingAs
parseValue = \case
TestName
"failure" -> forall a. a -> Maybe a
Just TreatPendingAs
TreatPendingAsFailure
TestName
"success" -> forall a. a -> Maybe a
Just TreatPendingAs
TreatPendingAsSuccess
TestName
_ -> forall a. Maybe a
Nothing
optionName :: Tagged TreatPendingAs TestName
optionName =
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"treat-pending-as"
optionHelp :: Tagged TreatPendingAs TestName
optionHelp =
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"How to treat pending hspec tests ('failure' or 'success')"
#if MIN_VERSION_tasty(1,3,0)
showDefaultValue :: TreatPendingAs -> Maybe TestName
showDefaultValue TreatPendingAs
_ =
forall a. a -> Maybe a
Just TestName
"failure"
#endif