{-# LANGUAGE CPP #-}

module Test.Tasty.Hspec.Compat
  ( itemExample,
    itemIsFocused,
    focus,
    optionSetToQuickCheckArgs,

    pattern Leaf,
    pattern Node,
    pattern NodeWithCleanup,
  )
where

import qualified Test.Hspec as Hspec
import qualified Test.Hspec.Core.Spec as Hspec
import qualified Test.QuickCheck as QuickCheck
import qualified Test.Tasty.Options as Tasty
import qualified Test.Tasty.QuickCheck as Tasty.QuickCheck

{-# COMPLETE Leaf, Node, NodeWithCleanup #-}

pattern Leaf :: a -> Hspec.Tree c a
pattern $mLeaf :: forall r a c. Tree c a -> (a -> r) -> (Void# -> r) -> r
Leaf item <-
  Hspec.Leaf item

pattern Node :: String -> [Hspec.Tree c a] -> Hspec.Tree c a
pattern $mNode :: forall r c a.
Tree c a -> (String -> [Tree c a] -> r) -> (Void# -> r) -> r
Node name trees <-
  Hspec.Node name trees

pattern NodeWithCleanup :: c -> [Hspec.Tree c a] -> Hspec.Tree c a
pattern $mNodeWithCleanup :: forall r c a.
Tree c a -> (c -> [Tree c a] -> r) -> (Void# -> r) -> r
NodeWithCleanup cleanup trees <-
#if MIN_VERSION_hspec(2,8,0)
  Hspec.NodeWithCleanup _loc cleanup trees
#else
  Hspec.NodeWithCleanup cleanup trees
#endif

itemExample :: Hspec.Item a -> Hspec.Params -> (Hspec.ActionWith a -> IO ()) -> Hspec.ProgressCallback -> IO Hspec.Result
itemExample :: Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item a
item =
  case Item a
item of
#if MIN_VERSION_hspec(2,6,0)
    Hspec.Item String
_ Maybe Location
_ Maybe Bool
_ Bool
_ Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
example -> Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
example
#else
    Hspec.Item _ _ _ example -> example
#endif

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

focus :: Hspec.Spec -> Hspec.Spec
focus :: Spec -> Spec
focus =
#if MIN_VERSION_hspec(2,6,0)
  Spec -> Spec
forall a. SpecWith a -> SpecWith a
Hspec.focus
#else
  id
#endif

optionSetToQuickCheckArgs :: Tasty.OptionSet -> IO QuickCheck.Args
optionSetToQuickCheckArgs :: OptionSet -> IO Args
optionSetToQuickCheckArgs 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)
Tasty.QuickCheck.optionSetToArgs OptionSet
opts
#else
  pure
    QuickCheck.stdArgs
      { QuickCheck.chatty = False,
        QuickCheck.maxDiscardRatio = max_ratio,
        QuickCheck.maxSize = max_size,
        QuickCheck.maxSuccess = num_tests,
        QuickCheck.replay = replay
      }
  where
    Tasty.QuickCheck.QuickCheckTests num_tests = T.lookupOption opts
    Tasty.QuickCheck.QuickCheckReplay replay = T.lookupOption opts
    Tasty.QuickCheck.QuickCheckMaxSize max_size = T.lookupOption opts
    Tasty.QuickCheck.QuickCheckMaxRatio max_ratio = T.lookupOption opts
#endif