-- | @<https://hackage.haskell.org/package/hspec hspec>@ and @<https://hackage.haskell.org/package/tasty tasty>@ serve
-- similar purposes; consider using one or the other.
--
-- However, in a pinch, this module allows you to run an @<https://hackage.haskell.org/package/hspec hspec>@
-- 'Hspec.Spec' as a @<https://hackage.haskell.org/package/tasty tasty>@ 'Tasty.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.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

-- $examples
--
-- The simplest usage of this library involves first creating a 'Tasty.TestTree' in @IO@, then running it with
-- 'Tasty.defaultMain'.
--
-- @
-- main = do
--   spec <- 'testSpec' "spec" mySpec
--   'Tasty.defaultMain' ('Tasty.testGroup' "tests" [spec])
-- @
--
-- You can treat an 'Hspec.pending'/'Hspec.pendingWith' test as a success instead of a failure (the default):
--
-- @
-- main = do
--   spec <- 'testSpec' "spec" mySpec
--   'Tasty.defaultMain' ('Tasty.localOption' 'TreatPendingAsSuccess' ('Tasty.testGroup' "tests" [spec]))
-- @
--
-- If you don't do any @IO@ during 'Hspec.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
--   'Tasty.defaultMain' ('Tasty.testGroup' "tests" [unsafePerformIO ('testSpec' "spec" mySpec)])
-- @

-- | Create a @<https://hackage.haskell.org/package/tasty tasty>@ 'Tasty.TestTree' from an
-- @<https://hackage.haskell.org/package/hspec hspec>@ 'Hspec.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 a. a -> IO a
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>@ 'Tasty.TestTree' from an
-- @<https://hackage.haskell.org/package/hspec hspec>@ 'Hspec.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.
  (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
    -- optionSetToQuickCheckArgs :: Tasty.OptionSet -> IO QuickCheck.Args
    -- optionSetToQuickCheckArgs opts =
    --   snd <$> Tasty.QuickCheck.optionSetToArgs 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)
      ]

-- | How to treat @<https://hackage.haskell.org/package/hspec hspec>@ pending tests.
--
-- @<https://hackage.haskell.org/package/tasty 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 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"