{-# 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
  TestTree -> IO TestTree
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 <- Spec -> IO [SpecTree ()]
forall a. SpecWith a -> IO [SpecTree a]
runSpecM (Spec -> Spec
focus Spec
spec)
  [TestTree] -> IO [TestTree]
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
  Node TestName
name [SpecTree ()]
trees -> TestTree -> Maybe TestTree
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))
  NodeWithCleanup IO ()
cleanup [SpecTree ()]
trees -> do
    TestTree
tree <- SpecTree () -> Maybe TestTree
specTreeToTestTree (TestName -> [SpecTree ()] -> SpecTree ()
forall c a. TestName -> [Tree c a] -> Tree c a
Node TestName
"(unnamed)" [SpecTree ()]
trees)
    TestTree -> Maybe TestTree
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> () -> IO ()
twiddleCleanup IO ()
cleanup)) (TestTree -> IO () -> TestTree
forall a b. a -> b -> a
const TestTree
tree))
  Leaf Item ()
item -> do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Item () -> Bool
forall a. Item a -> Bool
itemIsFocused Item ()
item)
    TestTree -> Maybe TestTree
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
    Args
qcArgs <- OptionSet -> IO Args
optionSetToQuickCheckArgs OptionSet
opts
    let params :: Params
params =
          Params :: Args -> Maybe Int -> 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 <- Item ()
-> Params
-> ((() -> IO ()) -> IO ())
-> ProgressCallback
-> IO Result
forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
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 (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
              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.Core.Formatters.formatException SomeException
exception)
      )
    where
      progress' :: (a, a) -> IO ()
progress' (a
x, a
y) =
        Progress -> IO ()
progress
          Progress :: TestName -> Float -> 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 (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 TQC.QuickCheckTests),
        Proxy QuickCheckReplay -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy QuickCheckReplay
forall k (t :: k). Proxy t
Proxy :: Proxy TQC.QuickCheckReplay),
        Proxy QuickCheckMaxSize -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy QuickCheckMaxSize
forall k (t :: k). Proxy t
Proxy :: Proxy TQC.QuickCheckMaxSize),
        Proxy QuickCheckMaxRatio -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy QuickCheckMaxRatio
forall k (t :: k). Proxy t
Proxy :: Proxy TQC.QuickCheckMaxRatio),
        Proxy SmallCheckDepth -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Options.Option (Proxy SmallCheckDepth
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" -> 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 (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"treat-pending-as"

  optionHelp :: Tagged TreatPendingAs TestName
optionHelp =
    TestName -> Tagged TreatPendingAs TestName
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
_ =
    TestName -> Maybe TestName
forall a. a -> Maybe a
Just TestName
"failure"
#endif