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.Api.Formatters.V1 as Hspec.Api.Formatters.V1
import qualified Test.Hspec.Core.Spec as Hspec.Core.Spec
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.Options as Tasty.Options
import qualified Test.Tasty.Providers as Tasty.Providers
import qualified Test.Tasty.QuickCheck as Tasty.QuickCheck
import qualified Test.Tasty.Runners as Tasty.Runners
import qualified Test.Tasty.SmallCheck as Tasty.SmallCheck
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
TestTree -> IO TestTree
forall a. a -> IO a
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
(Endo Config
_configBuilder, [SpecTree ()]
trees) <- Spec -> IO (Endo Config, [SpecTree ()])
forall a. SpecWith a -> IO (Endo Config, [SpecTree a])
Hspec.Core.Spec.runSpecM (Spec -> Spec
forall a. SpecWith a -> SpecWith a
Hspec.focus Spec
spec)
[TestTree] -> IO [TestTree]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SpecTree () -> Maybe TestTree) -> [SpecTree ()] -> [TestTree]
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
Hspec.Core.Spec.Node TestName
name [SpecTree ()]
trees -> TestTree -> Maybe TestTree
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestName -> [TestTree] -> TestTree
Tasty.testGroup TestName
name ((SpecTree () -> Maybe TestTree) -> [SpecTree ()] -> [TestTree]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SpecTree () -> Maybe TestTree
specTreeToTestTree [SpecTree ()]
trees))
Hspec.Core.Spec.NodeWithCleanup Maybe (TestName, Location)
_loc IO ()
cleanup [SpecTree ()]
trees -> do
TestTree
tree <- SpecTree () -> Maybe TestTree
specTreeToTestTree (TestName -> [SpecTree ()] -> SpecTree ()
forall c a. TestName -> [Tree c a] -> Tree c a
Hspec.Core.Spec.Node TestName
"(unnamed)" [SpecTree ()]
trees)
TestTree -> Maybe TestTree
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceSpec () -> (IO () -> TestTree) -> TestTree
forall a. ResourceSpec a -> (IO a -> TestTree) -> TestTree
Tasty.Runners.WithResource (IO () -> (() -> IO ()) -> ResourceSpec ()
forall a. IO a -> (a -> IO ()) -> ResourceSpec a
Tasty.Runners.ResourceSpec (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> () -> IO ()
forall a b. a -> b -> a
const IO ()
cleanup)) (TestTree -> IO () -> TestTree
forall a b. a -> b -> a
const TestTree
tree))
Hspec.Core.Spec.Leaf Item ()
item -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Item () -> Bool
forall a. Item a -> Bool
Hspec.Core.Spec.itemIsFocused Item ()
item)
TestTree -> Maybe TestTree
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestName -> Item -> TestTree
forall t. IsTest t => TestName -> t -> TestTree
Tasty.Providers.singleTest (Item () -> TestName
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
(Int
_, Args
qcArgs) <- OptionSet -> IO (Int, Args)
Tasty.QuickCheck.optionSetToArgs 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 =
case OptionSet -> SmallCheckDepth
forall v. IsOption v => OptionSet -> v
Tasty.Options.lookupOption OptionSet
opts of
Tasty.SmallCheck.SmallCheckDepth Int
depth -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
depth
}
Hspec.Core.Spec.Result TestName
_ ResultStatus
result <- Item ()
-> Params
-> ((() -> IO ()) -> IO ())
-> ProgressCallback
-> IO Result
forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
Hspec.Core.Spec.itemExample Item ()
item Params
params ((() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()) ProgressCallback
forall {a} {a}. (Integral a, Integral a) => (a, a) -> IO ()
progress'
Result -> IO Result
forall a. a -> IO a
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 OptionSet -> TreatPendingAs
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: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName -> Maybe TestName -> TestName
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
Hspec.Core.Spec.ColorizedReason TestName
x -> TestName -> Result
Tasty.Providers.testFailed TestName
x
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 (TestName -> Result)
-> ([Maybe TestName] -> TestName) -> [Maybe TestName] -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestName] -> TestName
unlines ([TestName] -> TestName)
-> ([Maybe TestName] -> [TestName]) -> [Maybe TestName] -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe TestName] -> [TestName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TestName] -> Result) -> [Maybe TestName] -> Result
forall a b. (a -> b) -> a -> b
$
[ Maybe TestName
preface,
TestName -> Maybe TestName
forall a. a -> Maybe a
Just (TestName
"expected: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
expected),
TestName -> Maybe TestName
forall a. a -> Maybe a
Just (TestName
" but got: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
actual)
]
Hspec.Core.Spec.Error Maybe TestName
_ SomeException
exception ->
TestName -> Result
Tasty.Providers.testFailed (TestName
"uncaught exception: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ SomeException -> TestName
Hspec.Api.Formatters.V1.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 = a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y
}
testOptions :: Tagged Item [OptionDescription]
testOptions =
[OptionDescription] -> Tagged Item [OptionDescription]
forall a. a -> Tagged Item a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ Proxy TreatPendingAs -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy TreatPendingAs
forall {k} (t :: k). Proxy t
Proxy :: Proxy TreatPendingAs),
Proxy QuickCheckTests -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy QuickCheckTests
forall {k} (t :: k). Proxy t
Proxy :: Proxy Tasty.QuickCheck.QuickCheckTests),
Proxy QuickCheckReplay -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy QuickCheckReplay
forall {k} (t :: k). Proxy t
Proxy :: Proxy Tasty.QuickCheck.QuickCheckReplay),
Proxy QuickCheckMaxSize -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy QuickCheckMaxSize
forall {k} (t :: k). Proxy t
Proxy :: Proxy Tasty.QuickCheck.QuickCheckMaxSize),
Proxy QuickCheckMaxRatio -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy QuickCheckMaxRatio
forall {k} (t :: k). Proxy t
Proxy :: Proxy Tasty.QuickCheck.QuickCheckMaxRatio),
Proxy SmallCheckDepth -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy SmallCheckDepth
forall {k} (t :: k). Proxy t
Proxy :: Proxy Tasty.SmallCheck.SmallCheckDepth)
]
data TreatPendingAs
=
TreatPendingAsFailure
| TreatPendingAsSuccess
instance Tasty.Options.IsOption TreatPendingAs where
defaultValue :: TreatPendingAs
defaultValue =
TreatPendingAs
TreatPendingAsFailure
parseValue :: TestName -> Maybe TreatPendingAs
parseValue = \case
TestName
"failure" -> TreatPendingAs -> Maybe TreatPendingAs
forall a. a -> Maybe a
Just TreatPendingAs
TreatPendingAsFailure
TestName
"success" -> TreatPendingAs -> Maybe TreatPendingAs
forall a. a -> Maybe a
Just TreatPendingAs
TreatPendingAsSuccess
TestName
_ -> Maybe TreatPendingAs
forall a. Maybe a
Nothing
optionName :: Tagged TreatPendingAs TestName
optionName =
TestName -> Tagged TreatPendingAs TestName
forall a. a -> Tagged TreatPendingAs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"treat-pending-as"
optionHelp :: Tagged TreatPendingAs TestName
optionHelp =
TestName -> Tagged TreatPendingAs TestName
forall a. a -> Tagged TreatPendingAs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"How to treat pending hspec tests ('failure' or 'success')"
showDefaultValue :: TreatPendingAs -> Maybe TestName
showDefaultValue TreatPendingAs
_ =
TestName -> Maybe TestName
forall a. a -> Maybe a
Just TestName
"failure"