{-# LANGUAGE CPP #-}

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

    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
import qualified Test.Tasty.SmallCheck as Tasty.SmallCheck
#if MIN_VERSION_hspec_core(2,10,0)
import Data.Monoid (Endo)
import qualified Test.Hspec.Core.Runner as Hspec.Core.Runner
#endif

{-# 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 $bNode :: String -> [Tree c a] -> Tree c a
$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

-- In hspec-core-2.10.0, Int changed to Maybe Int
optionSetToSmallCheckDepth ::
  Tasty.OptionSet ->
#if MIN_VERSION_hspec_core(2,10,0)
  Maybe
#endif
  Int
optionSetToSmallCheckDepth :: OptionSet -> Maybe Int
optionSetToSmallCheckDepth OptionSet
opts =
  case OptionSet -> SmallCheckDepth
forall v. IsOption v => OptionSet -> v
Tasty.lookupOption OptionSet
opts of
    Tasty.SmallCheck.SmallCheckDepth Int
depth ->
#if MIN_VERSION_hspec_core(2,10,0)
      Int -> Maybe Int
forall a. a -> Maybe a
Just
#endif
      Int
depth

-- In hspec-core-2.10.0, runSpecM started returning an Endo Config, which we don't need. (Right? :shrug:)
runSpecM :: Hspec.SpecWith a -> IO [Hspec.SpecTree a]
runSpecM :: SpecWith a -> IO [SpecTree a]
runSpecM SpecWith a
spec = do
#if MIN_VERSION_hspec_core(2,10,0)
  (Endo Config
_ :: Endo Hspec.Core.Runner.Config, [SpecTree a]
trees) <- SpecWith a -> IO (Endo Config, [SpecTree a])
forall a. SpecWith a -> IO (Endo Config, [SpecTree a])
Hspec.runSpecM SpecWith a
spec
  [SpecTree a] -> IO [SpecTree a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SpecTree a]
trees
#else
  Hspec.runSpecM spec
#endif

-- In hspec-core-2.10.0, the spec SpecTree type alias changed from
--
--   type SpecTree a = Tree (a -> IO ()) (Item a)
--
-- to
--
--   type SpecTree a = Tree (IO ()) (Item a)
--
-- So we have a function that "twiddles" the cleanup action (at monomorphic type `SpecTree ()`), which always returns a
-- value of type `() -> IO ()`
#if MIN_VERSION_hspec_core(2,10,0)
twiddleCleanup :: IO () -> () -> IO ()
twiddleCleanup :: IO () -> () -> IO ()
twiddleCleanup =
  IO () -> () -> IO ()
forall a b. a -> b -> a
const
#else
twiddleCleanup :: (() -> IO ()) -> () -> IO ()
twiddleCleanup =
  id
#endif