{-# LANGUAGE CPP #-}

-- | @hspec@ and @tasty@ serve similar purposes; consider using one or the
-- other.
--
-- However, in a pinch, this module allows you to run an @hspec@ 'H.Spec' as a
-- @tasty@ 'T.TestTree'.
module Test.Tasty.Hspec
  ( -- * Tests
    testSpec,
    testSpecs,

    -- * Options
    TreatPendingAs (..),

    -- * Examples
    -- $examples
  )
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

-- $examples
--
-- The simplest usage of this library involves first creating a 'T.TestTree' in @IO@, then running it with
-- 'T.defaultMain'.
--
-- @
-- main = do
--   spec <- 'testSpec' "spec" mySpec
--   'T.defaultMain'
--     ('T.testGroup' "tests"
--       [ spec
--       , ...
--       ])
-- @
--
-- You can treat an 'H.pending'/'H.pendingWith' test as a success instead of a
-- failure (the default):
--
-- @
-- tests :: TestTree
-- tests =
--   localOption TreatPendingAsSuccess $ testGroup "My Hspec TestTree"
--     [ unsafePerformIO (testSpec "My first Hspec test" spec_firstHspecTest)
--     , ...
--     ]
-- @
--
-- If you don't do any @IO@ during 'Spec' creation, or the @IO@ need
-- not be performed at any particular time relative to other @IO@ actions, it's
-- perfectly fine to use 'System.IO.unsafePerformIO'.
--
-- @
-- main = do
--   'T.defaultMain'
--     ('T.testGroup' "tests"
--       [ 'System.IO.unsafePerformIO' ('testSpec' "spec" mySpec)
--       , ...
--       ])
-- @

-- | Create a <https://hackage.haskell.org/package/tasty tasty> 'T.TestTree' from an
-- <https://hackage.haskell.org/package/hspec hspec> 'H.Spec'.
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)

-- | Create a list of <https://hackage.haskell.org/package/tasty tasty> 'T.TestTree' from an
-- <https://hackage.haskell.org/package/hspec hspec> 'H.Spec'. This returns the same tests as 'testSpec'
-- but doesn't create a <https://hackage.haskell.org/package/tasty tasty> test group from them.
testSpecs :: Hspec.Spec -> IO [Tasty.TestTree]
testSpecs :: Spec -> IO [TestTree]
testSpecs Spec
spec = do
  -- Here we do as hspec does, which is pre-process a spec by focusing the whole thing, which is a no-op if
  -- anything inside is already focused, but otherwise focuses every item. Then, when creating a tasty test tree,
  -- we just toss the unfocused items.
  [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)
      ]

-- | How to treat @hspec@ pending tests.
--
-- @tasty@ does not have the concept of pending tests, so we must map them to
-- either successes or failures. By default, they are treated as failures.
--
-- Set via the command line flag @--treat-pending-as (success|failure)@.
data TreatPendingAs
  = -- | Default.
    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