    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE InstanceSigs       #-}
    {-# LANGUAGE LambdaCase         #-}

    module Test.Tasty.Hspec (
        -- * Test
          testSpec
        , testSpecs
        -- * Options
        -- | === Re-exported from <https://hackage.haskell.org/package/tasty-smallcheck tasty-smallcheck>
        , SmallCheckDepth(..)
        -- | === Re-exported from <https://hackage.haskell.org/package/tasty-quickcheck tasty-quickcheck>
        , QuickCheckMaxRatio(..)
        , QuickCheckMaxSize(..)
        , QuickCheckReplay(..)
        , QuickCheckTests(..)
        -- * Hspec re-export
        , module Test.Hspec
        ) where

    import Control.Applicative ((<$>))
    import Data.Monoid (mconcat)
    import Data.Proxy
    import Data.Tagged (Tagged)
    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
    import Test.Tasty.SmallCheck (SmallCheckDepth(..))
    import Test.Tasty.QuickCheck
      (QuickCheckMaxRatio(..), QuickCheckMaxSize(..), QuickCheckReplay(..),
        QuickCheckTests(..))

    -- | 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 name spec = T.testGroup name <$> testSpecs spec

    -- | Create a list of <https://hackage.haskell.org/package/tasty tasty>
    -- 'T.TestTree' from a <https://hackage.haskell.org/package/hspec Hspec>
    -- 'H.Spec' test. 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 = map specTreeToTestTree <$> H.runSpecM spec

    specTreeToTestTree :: H.SpecTree () -> T.TestTree
    specTreeToTestTree = \case
      H.Node name spec_trees ->
        T.testGroup name (map specTreeToTestTree spec_trees)
      H.NodeWithCleanup cleanup spec_trees ->
        T.WithResource (T.ResourceSpec (return ()) cleanup) (const test_tree)
       where
        test_tree :: T.TestTree
        test_tree = specTreeToTestTree (H.Node "(unnamed)" spec_trees)
      H.Leaf item ->
        T.singleTest (H.itemRequirement 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 opts (Item (H.Item _ _ _ ex)) progress = do
        qc_args <- tastyOptionSetToQuickCheckArgs opts

        let params :: H.Params
            params = H.Params
              { H.paramsQuickCheckArgs = qc_args
              , H.paramsSmallCheckDepth = sc_depth
              }

    #if MIN_VERSION_hspec(2,4,0)
        either (T.testFailed . H.formatException) hspecResultToTastyResult
    #else
        hspecResultToTastyResult
    #endif
          <$> ex params ($ ()) hprogress
       where
        sc_depth :: Int
        sc_depth = depth
         where
          TSC.SmallCheckDepth depth = T.lookupOption opts

        hprogress :: H.Progress -> IO ()
        hprogress (x,y) = progress (T.Progress
          { T.progressText    = ""
          , T.progressPercent = fromIntegral x / fromIntegral y
          })

      testOptions :: Tagged Item [T.OptionDescription]
      testOptions = return
        [ T.Option (Proxy :: Proxy TQC.QuickCheckTests)
        , T.Option (Proxy :: Proxy TQC.QuickCheckReplay)
        , T.Option (Proxy :: Proxy TQC.QuickCheckMaxSize)
        , T.Option (Proxy :: Proxy TQC.QuickCheckMaxRatio)
        , T.Option (Proxy :: Proxy TSC.SmallCheckDepth)
        ]

    tastyOptionSetToQuickCheckArgs :: T.OptionSet -> IO QC.Args
    tastyOptionSetToQuickCheckArgs opts =
    #if MIN_VERSION_tasty_quickcheck(0,9,1)
      snd <$> TQC.optionSetToArgs 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 :: H.Result -> T.Result
    hspecResultToTastyResult = \case
      H.Success -> T.testPassed ""
      H.Pending mstr -> T.testFailed ("Test pending" ++ maybe "" (": " ++) mstr)
    #if MIN_VERSION_hspec(2,4,0)
      H.Failure _ reason ->
        case reason of
          H.NoReason   -> T.testFailed ""
          H.Reason str -> T.testFailed str
          H.ExpectedButGot preface expected actual ->
            T.testFailed $ mconcat
              [ maybe "" (++ ": ") preface
              , "expected " ++ expected
              , ", but got " ++ actual
              ]
    #elif MIN_VERSION_hspec(2,2,0)
      H.Fail _ str -> T.testFailed str
    #else
      H.Fail str -> T.testFailed str
    #endif