    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE DeriveDataTypeable #-}

    -- | @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(..)
        -- * Re-exports
        , module Test.Hspec
          -- * Examples
          -- $examples
        ) where

    import Control.Applicative ((<$>))
    import Control.Exception (SomeException)
    import Control.Monad (guard)
    import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
    import Data.Proxy
    import Data.Typeable (Typeable)

    import qualified Test.Hspec as H
    import qualified Test.Hspec.Core.Formatters as H
    import qualified Test.Hspec.Core.Spec as H
    import qualified Test.QuickCheck as QC
    import qualified Test.Tasty as T
    import qualified Test.Tasty.SmallCheck as TSC
    import qualified Test.Tasty.Options as T
    import qualified Test.Tasty.Providers as T
    import qualified Test.Tasty.QuickCheck as TQC
    import qualified Test.Tasty.Runners as T

    -- For re-export.
    import Test.Hspec

    -- $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
    --       , ...
    --       ])
    -- @
    --
    -- However, 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 :: T.TestName -> H.Spec -> IO T.TestTree
    testSpec :: TestName -> Spec -> IO TestTree
    testSpec name :: TestName
    name spec :: Spec
    spec = TestName -> [TestTree] -> TestTree
    T.testGroup TestName
    name ([TestTree] -> TestTree) -> IO [TestTree] -> IO TestTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Spec -> IO [TestTree]
    testSpecs Spec
    spec

    -- | 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 :: H.Spec -> IO [T.TestTree]
    testSpecs :: Spec -> IO [TestTree]
    testSpecs spec :: Spec
    spec =
      [Maybe TestTree] -> [TestTree]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TestTree] -> [TestTree])
    -> ([SpecTree ()] -> [Maybe TestTree])
    -> [SpecTree ()]
    -> [TestTree]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SpecTree () -> Maybe TestTree)
    -> [SpecTree ()] -> [Maybe TestTree]
    forall a b. (a -> b) -> [a] -> [b]
    map SpecTree () -> Maybe TestTree
    specTreeToTestTree ([SpecTree ()] -> [TestTree]) -> IO [SpecTree ()] -> IO [TestTree]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        -- In hspec 2.6.0, "focus" was introduced. 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.
        Spec -> IO [SpecTree ()]
    forall a. SpecWith a -> IO [SpecTree a]
    H.runSpecM (Spec -> Spec
    doFocus Spec
    spec)
      where
        doFocus :: H.Spec -> H.Spec
        doFocus :: Spec -> Spec
    doFocus =
    #if MIN_VERSION_hspec(2,6,0)
          Spec -> Spec
    forall a. SpecWith a -> SpecWith a
    H.focus
    #else
          id
    #endif

    specTreeToTestTree :: H.SpecTree () -> Maybe T.TestTree
    specTreeToTestTree :: SpecTree () -> Maybe TestTree
    specTreeToTestTree spec_tree :: SpecTree ()
    spec_tree =
      case SpecTree ()
    spec_tree of
        H.Node name :: TestName
    name spec_trees :: [SpecTree ()]
    spec_trees ->
          TestTree -> Maybe TestTree
    forall a. a -> Maybe a
    Just (TestName -> [TestTree] -> TestTree
    T.testGroup TestName
    name ((SpecTree () -> Maybe TestTree) -> [SpecTree ()] -> [TestTree]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe SpecTree () -> Maybe TestTree
    specTreeToTestTree [SpecTree ()]
    spec_trees))
        H.NodeWithCleanup cleanup :: ActionWith ()
    cleanup spec_trees :: [SpecTree ()]
    spec_trees ->
          ResourceSpec () -> (IO () -> TestTree) -> TestTree
    forall a. ResourceSpec a -> (IO a -> TestTree) -> TestTree
    T.WithResource (IO () -> ActionWith () -> ResourceSpec ()
    forall a. IO a -> (a -> IO ()) -> ResourceSpec a
    T.ResourceSpec (ActionWith ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) ActionWith ()
    cleanup) ((IO () -> TestTree) -> TestTree)
    -> (TestTree -> IO () -> TestTree) -> TestTree -> TestTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestTree -> IO () -> TestTree
    forall a b. a -> b -> a
    const (TestTree -> TestTree) -> Maybe TestTree -> Maybe TestTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe TestTree
    test_tree
         where
          test_tree :: Maybe T.TestTree
          test_tree :: Maybe TestTree
    test_tree = SpecTree () -> Maybe TestTree
    specTreeToTestTree (TestName -> [SpecTree ()] -> SpecTree ()
    forall c a. TestName -> [Tree c a] -> Tree c a
    H.Node "(unnamed)" [SpecTree ()]
    spec_trees)
        H.Leaf item :: Item ()
    item -> do
          Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Item () -> Bool
    forall a. Item a -> Bool
    hspecItemIsFocused Item ()
    item)
          TestTree -> Maybe TestTree
    forall a. a -> Maybe a
    Just (TestName -> Item -> TestTree
    forall t. IsTest t => TestName -> t -> TestTree
    T.singleTest (Item () -> TestName
    forall a. Item a -> TestName
    H.itemRequirement Item ()
    item) (Item () -> Item
    Item Item ()
    item))

    newtype Item
      = Item (H.Item ())
      deriving Typeable

    instance T.IsTest Item where
      -- run :: T.OptionSet -> Item -> (T.Progress -> IO ()) -> IO T.Result
      run :: OptionSet -> Item -> (Progress -> IO ()) -> IO Result
    run opts :: OptionSet
    opts (Item item :: Item ()
    item) progress :: Progress -> IO ()
    progress = do
        Args
    qc_args <- OptionSet -> IO Args
    tastyOptionSetToQuickCheckArgs OptionSet
    opts

        let
          pending_ :: String -> T.Result
          pending_ :: TestName -> Result
    pending_ =
            case OptionSet -> TreatPendingAs
    forall v. IsOption v => OptionSet -> v
    T.lookupOption OptionSet
    opts of
              Failure ->
                TestName -> Result
    T.testFailed
              Success ->
                TestName -> Result
    T.testPassed

        let
          params :: H.Params
          params :: Params
    params = Params :: Args -> Int -> Params
    H.Params
            { paramsQuickCheckArgs :: Args
    H.paramsQuickCheckArgs = Args
    qc_args
            , paramsSmallCheckDepth :: Int
    H.paramsSmallCheckDepth = Int
    sc_depth
            }

    #if MIN_VERSION_hspec(2,4,0) && !MIN_VERSION_hspec(2,5,0)
        either handleUncaughtException (hspecResultToTastyResult pending_)
    #else
        (TestName -> Result) -> Result -> Result
    hspecResultToTastyResult TestName -> Result
    pending_
    #endif
          (Result -> Result) -> IO Result -> IO Result
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Item ()
    -> Params
    -> (ActionWith () -> IO ())
    -> ProgressCallback
    -> IO Result
    forall a.
    Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    hspecItemToExample Item ()
    item Params
    params (ActionWith () -> ActionWith ()
    forall a b. (a -> b) -> a -> b
    $ ()) ProgressCallback
    hprogress

       where
        sc_depth :: Int
        sc_depth :: Int
    sc_depth = Int
    depth
         where
          TSC.SmallCheckDepth depth :: Int
    depth = OptionSet -> SmallCheckDepth
    forall v. IsOption v => OptionSet -> v
    T.lookupOption OptionSet
    opts

        hprogress :: H.Progress -> IO ()
        hprogress :: ProgressCallback
    hprogress (x :: Int
    x,y :: Int
    y) = Progress -> IO ()
    progress Progress :: TestName -> Float -> Progress
    T.Progress
          { progressText :: TestName
    T.progressText    = ""
          , progressPercent :: Float
    T.progressPercent = Int -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    x Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    / Int -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    y
          }

      -- testOptions :: Tagged Item [T.OptionDescription]
      testOptions :: Tagged Item [OptionDescription]
    testOptions = [OptionDescription] -> Tagged Item [OptionDescription]
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        [ Proxy TreatPendingAs -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    T.Option (Proxy TreatPendingAs
    forall k (t :: k). Proxy t
    Proxy :: Proxy TreatPendingAs)
        , Proxy QuickCheckTests -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    T.Option (Proxy QuickCheckTests
    forall k (t :: k). Proxy t
    Proxy :: Proxy TQC.QuickCheckTests)
        , Proxy QuickCheckReplay -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    T.Option (Proxy QuickCheckReplay
    forall k (t :: k). Proxy t
    Proxy :: Proxy TQC.QuickCheckReplay)
        , Proxy QuickCheckMaxSize -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    T.Option (Proxy QuickCheckMaxSize
    forall k (t :: k). Proxy t
    Proxy :: Proxy TQC.QuickCheckMaxSize)
        , Proxy QuickCheckMaxRatio -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    T.Option (Proxy QuickCheckMaxRatio
    forall k (t :: k). Proxy t
    Proxy :: Proxy TQC.QuickCheckMaxRatio)
        , Proxy SmallCheckDepth -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    T.Option (Proxy SmallCheckDepth
    forall k (t :: k). Proxy t
    Proxy :: Proxy TSC.SmallCheckDepth)
        ]

    tastyOptionSetToQuickCheckArgs :: T.OptionSet -> IO QC.Args
    tastyOptionSetToQuickCheckArgs :: OptionSet -> IO Args
    tastyOptionSetToQuickCheckArgs opts :: OptionSet
    opts =
    #if MIN_VERSION_tasty_quickcheck(0,9,1)
      (Int, Args) -> Args
    forall a b. (a, b) -> b
    snd ((Int, Args) -> Args) -> IO (Int, Args) -> IO Args
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> OptionSet -> IO (Int, Args)
    TQC.optionSetToArgs OptionSet
    opts
    #else
      return (QC.stdArgs
        { QC.chatty          = False
        , QC.maxDiscardRatio = max_ratio
        , QC.maxSize         = max_size
        , QC.maxSuccess      = num_tests
        , QC.replay          = replay
        })
     where
      TQC.QuickCheckTests    num_tests = T.lookupOption opts
      TQC.QuickCheckReplay   replay    = T.lookupOption opts
      TQC.QuickCheckMaxSize  max_size  = T.lookupOption opts
      TQC.QuickCheckMaxRatio max_ratio = T.lookupOption opts
    #endif

    hspecResultToTastyResult :: (String -> T.Result) -> H.Result -> T.Result
    #if MIN_VERSION_hspec(2,5,0)
    hspecResultToTastyResult :: (TestName -> Result) -> Result -> Result
    hspecResultToTastyResult pending_ :: TestName -> Result
    pending_ (H.Result _ result :: ResultStatus
    result) =
    #else
    hspecResultToTastyResult pending_ result =
    #endif
      case ResultStatus
    result of
        H.Success ->
          TestName -> Result
    T.testPassed ""

    #if MIN_VERSION_hspec(2,5,0)
        H.Pending _ x :: Maybe TestName
    x ->
    #else
        H.Pending x ->
    #endif
          (TestName -> Result) -> Maybe TestName -> Result
    handleResultPending TestName -> Result
    pending_ Maybe TestName
    x

    #if MIN_VERSION_hspec(2,4,0)
        H.Failure _ x :: FailureReason
    x ->
          FailureReason -> Result
    handleResultFailure FailureReason
    x
    #elif MIN_VERSION_hspec(2,2,0)
        H.Fail _ str -> T.testFailed str
    #else
        H.Fail str -> T.testFailed str
    #endif

    hspecItemIsFocused :: H.Item a -> Bool
    hspecItemIsFocused :: Item a -> Bool
    hspecItemIsFocused =
    #if MIN_VERSION_hspec(2,6,0)
      Item a -> Bool
    forall a. Item a -> Bool
    H.itemIsFocused
    #else
      const True
    #endif

    hspecItemToExample
      :: H.Item a
      -> H.Params
      -> (H.ActionWith a -> IO ())
      -> H.ProgressCallback
      -> IO H.Result
    #if MIN_VERSION_hspec(2,6,0)
    hspecItemToExample :: Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    hspecItemToExample (H.Item _ _ _ _ ex :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
    ex) = Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
    ex
    #else
    hspecItemToExample (H.Item _ _ _ ex) = ex
    #endif

    handleResultPending :: (String -> T.Result) -> Maybe String -> T.Result
    handleResultPending :: (TestName -> Result) -> Maybe TestName -> Result
    handleResultPending pending_ :: TestName -> Result
    pending_ x :: Maybe TestName
    x =
      TestName -> Result
    pending_ ("# PENDING: " TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName -> Maybe TestName -> TestName
    forall a. a -> Maybe a -> a
    fromMaybe "No reason given" Maybe TestName
    x)

    -- FailureReason
    --
    -- - Introduced in 2.4.0
    -- - Error constructor added in 2.5.0
    #if MIN_VERSION_hspec(2,4,0)
    handleResultFailure :: H.FailureReason -> T.Result
    handleResultFailure :: FailureReason -> Result
    handleResultFailure reason :: FailureReason
    reason =
      case FailureReason
    reason of
        H.NoReason -> TestName -> Result
    T.testFailed ""
        H.Reason x :: TestName
    x -> TestName -> Result
    T.testFailed TestName
    x
        H.ExpectedButGot preface :: Maybe TestName
    preface expected :: TestName
    expected actual :: TestName
    actual ->
          TestName -> Result
    T.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 ("expected: " TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    expected)
            , TestName -> Maybe TestName
    forall a. a -> Maybe a
    Just (" but got: " TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    actual)
            ]
    #if MIN_VERSION_hspec(2,5,0)
        H.Error _ ex :: SomeException
    ex ->
          SomeException -> Result
    handleUncaughtException SomeException
    ex
    #endif
    #endif

    handleUncaughtException :: SomeException -> T.Result
    handleUncaughtException :: SomeException -> Result
    handleUncaughtException ex :: SomeException
    ex =
      TestName -> Result
    T.testFailed ("uncaught exception: " TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> TestName
    H.formatException SomeException
    ex)

    -- | 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
      = Failure
      | Success

    instance T.IsOption TreatPendingAs where
      defaultValue :: TreatPendingAs
    defaultValue =
        TreatPendingAs
    Failure

      parseValue :: TestName -> Maybe TreatPendingAs
    parseValue s :: TestName
    s =
        case TestName
    s of
          "failure" -> TreatPendingAs -> Maybe TreatPendingAs
    forall a. a -> Maybe a
    Just TreatPendingAs
    Failure
          "success" -> TreatPendingAs -> Maybe TreatPendingAs
    forall a. a -> Maybe a
    Just TreatPendingAs
    Success
          _         -> 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 "treat-pending-as"

      optionHelp :: Tagged TreatPendingAs TestName
    optionHelp =
        TestName -> Tagged TreatPendingAs TestName
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "How to treat pending hspec tests ('failure' or 'success')"