{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

#if MIN_VERSION_base(4,6,0) && !MIN_VERSION_base(4,7,0)
-- Control.Concurrent.QSem is deprecated in base-4.6.0.*
{-# OPTIONS_GHC -fno-warn-deprecations #-}
#endif

module Test.Hspec.Core.RunnerSpec (spec) where

import           Prelude ()
import           Helper

import           System.IO
import           System.Environment (withArgs, withProgName, getArgs)
import           System.Exit
import           Control.Concurrent
import           Control.Concurrent.Async
import           Mock
import           System.SetEnv
import           System.Console.ANSI

import           Test.Hspec.Core.FailureReport (FailureReport(..))
import qualified Test.Hspec.Expectations as H
import qualified Test.Hspec.Core.Spec as H
import qualified Test.Hspec.Core.Runner as H
import           Test.Hspec.Core.Runner.Result
import qualified Test.Hspec.Core.Formatters.V2 as V2
import qualified Test.Hspec.Core.QuickCheck as H

import qualified Test.QuickCheck as QC
import qualified Test.Hspec.Core.Hooks as H

import           Test.Hspec.Core.Formatters.Pretty.ParserSpec (Person(..))

quickCheckOptions :: [([Char], Args -> Int)]
quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)]

runPropFoo :: [String] -> IO String
runPropFoo args = unlines . normalizeSummary . lines <$> do
  capture_ . ignoreExitCode . withArgs args . H.hspec .  H.modifyMaxSuccess (const 1000000) $ do
    H.it "foo" $ do
      property (/= (23 :: Int))

person :: Int -> Person
person = Person "Joe"

spec :: Spec
spec = do
  describe "hspec" $ do

    let
      hspec args = withArgs ("--format=silent" : args) . H.hspec
      hspec_ = hspec []

    it "evaluates examples Unmasked" $ do
      mvar <- newEmptyMVar
      hspec_ $ do
        H.it "foo" $ do
          getMaskingState >>= putMVar mvar
      takeMVar mvar `shouldReturn` Unmasked

    it "runs finalizers" $ do
      mvar <- newEmptyMVar
      ref <- newIORef "did not run finalizer"
      a <- async $ hspec_ $ do
          H.it "foo" $ do
            (putMVar mvar () >> threadDelay 10000000) `finally`
              writeIORef ref "ran finalizer"
      takeMVar mvar
      cancel a
      readIORef ref `shouldReturn` "ran finalizer"

    it "runs a spec" $ do
      hspec_ $ do
        H.it "foobar" True
      `shouldReturn` ()

    it "exits with exitFailure if not all examples pass" $ do
      hspec_ $ do
        H.it "foobar" False
      `shouldThrow` (== ExitFailure 1)

    it "allows output to stdout" $ do
      r <- captureLines . H.hspec $ do
        H.it "foobar" $ do
          putStrLn "baz"
      r `shouldSatisfy` elem "baz"

    it "prints an error message on unrecognized command-line options" $ do
      withProgName "myspec" . withArgs ["--foo"] $ do
        hSilence [stderr] (H.hspec $ pure ()) `shouldThrow` (== ExitFailure 1)
        fst `fmap` hCapture [stderr] (ignoreExitCode (H.hspec $ pure ())) `shouldReturn` unlines [
            "myspec: unrecognized option `--foo'"
          , "Try `myspec --help' for more information."
          ]

    it "stores a failure report in the environment" $ do
      ignoreExitCode . hspec ["--seed", "23"] $ do
        H.describe "foo" $ do
          H.describe "bar" $ do
            H.it "example 1" True
            H.it "example 2" False
        H.describe "baz" $ do
          H.it "example 3" False
      lookupEnv "HSPEC_FAILURES" `shouldReturn` (Just . show) FailureReport {
          failureReportSeed = 23
        , failureReportMaxSuccess = 100
        , failureReportMaxSize = 100
        , failureReportMaxDiscardRatio = 10
        , failureReportPaths = [
            (["foo", "bar"], "example 2")
          , (["baz"], "example 3")
          ]
        }

    describe "with --rerun" $ do
      let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do
            H.it "example 1" True
            H.it "example 2" False
            H.it "example 3" False
            H.it "example 4" True
            H.it "example 5" False

      it "reruns examples that previously failed" $ do
        r0 <- runSpec
        r0 `shouldSatisfy` elem "5 examples, 3 failures"

        r1 <- withArgs ["--rerun"] runSpec
        r1 `shouldSatisfy` elem "3 examples, 3 failures"

      it "reuses the same seed" $ do
        r <- runPropFoo ["--seed", "42"]
        runPropFoo ["--rerun"] `shouldReturn` r

      forM_ quickCheckOptions $ \(name, accessor) -> do
        it ("reuses same " ++ name) $ do
          [name, "23"] `shouldUseArgs` ((== 23) . accessor)
          ["--rerun"] `shouldUseArgs` ((== 23) . accessor)

      context "when no examples failed previously" $ do
        it "runs all examples" $ do
          let run = capture_ . H.hspec $ do
                H.it "example 1" True
                H.it "example 2" True
                H.it "example 3" True

          r0 <- run
          r0 `shouldContain` "3 examples, 0 failures"

          r1 <- withArgs ["--rerun"] run
          r1 `shouldContain` "3 examples, 0 failures"

      context "when there is no failure report in the environment" $ do
        it "runs everything" $ do
          unsetEnv "HSPEC_FAILURES"
          r <- hSilence [stderr] $ withArgs ["--rerun"] runSpec
          r `shouldSatisfy` elem "5 examples, 3 failures"

        it "prints a warning to stderr" $ do
          unsetEnv "HSPEC_FAILURES"
          r <- hCapture_ [stderr] $ withArgs ["--rerun"] runSpec
          r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n"

      context "when parsing of failure report fails" $ do
        it "runs everything" $ do
          setEnv "HSPEC_FAILURES" "some invalid report"
          r <- hSilence [stderr] $ withArgs ["--rerun"] runSpec
          r `shouldSatisfy` elem "5 examples, 3 failures"

        it "prints a warning to stderr" $ do
          setEnv "HSPEC_FAILURES" "some invalid report"
          r <- hCapture_ [stderr] $ withArgs ["--rerun"] runSpec
          r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n"


    it "does not leak command-line options to examples" $ do
      hspec ["--diff"] $ do
        H.it "foobar" $ do
          getArgs `shouldReturn` []
      `shouldReturn` ()

    context "when interrupted with ctrl-c" $ do
      it "prints summary immediately" $ do
        mvar <- newEmptyMVar
        sync <- newEmptyMVar
        threadId <- forkIO $ do
          r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec . removeLocations $ do
            H.it "foo" False
            H.it "bar" $ do
              putMVar sync ()
              threadDelay 1000000
            H.it "baz" True
          putMVar mvar r
        takeMVar sync
        throwTo threadId UserInterrupt
        r <- takeMVar mvar
        normalizeSummary r `shouldBe` [
            ""
          , "foo [✘]"
          , ""
          , "Failures:"
          , ""
          , "  1) foo"
          , ""
          , "  To rerun use: --match \"/foo/\""
          , ""
          , "Randomized with seed 23"
          , ""
          , "Finished in 0.0000 seconds"
          , "1 example, 1 failure"
          ]

      it "throws UserInterrupt" $ do
        mvar <- newEmptyMVar
        sync <- newEmptyMVar
        threadId <- forkIO $ do
          hspec_ $ do
            H.it "foo" $ do
              putMVar sync ()
              threadDelay 1000000
          `catch` putMVar mvar
        takeMVar sync
        throwTo threadId UserInterrupt
        takeMVar mvar `shouldReturn` UserInterrupt

    context "with --dry-run" $ do
      let withDryRun = captureLines . withArgs ["--dry-run"] . H.hspec
      it "produces a report" $ do
        r <- withDryRun $ do
          H.it "foo" True
          H.it "bar" True
        normalizeSummary r `shouldBe` [
            ""
          , "foo [✔]"
          , "bar [✔]"
          , ""
          , "Finished in 0.0000 seconds"
          , "2 examples, 0 failures"
          ]

      it "does not verify anything" $ do
        e <- newMock
        _ <- withDryRun $ do
          H.it "foo" (mockAction e)
          H.it "bar" False
        mockCounter e `shouldReturn` 0

      it "ignores afterAll-hooks" $ do
        ref <- newIORef False
        _ <- withDryRun $ do
          H.afterAll_ (writeIORef ref True) $ do
            H.it "bar" True
        readIORef ref `shouldReturn` False

    context "with --focused-only" $ do
      let run = captureLines . withArgs ["--focused-only"] . H.hspec
      context "when there aren't any focused spec items" $ do
        it "does not run anything" $ do
          r <- run $ do
            H.it "foo" True
            H.it "bar" True
          normalizeSummary r `shouldBe` [
              ""
            , ""
            , "Finished in 0.0000 seconds"
            , "0 examples, 0 failures"
            ]

    context "with --fail-on=empty" $ do
      it "fails if no spec items have been run" $ do
        (out, r) <- hCapture [stdout, stderr] . try . withProgName "spec" . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do
          H.it "foo" True
          H.it "bar" True
          H.it "baz" True
        unlines (normalizeSummary (lines out)) `shouldBe` unlines [
            "spec: all spec items have been filtered; failing due to --fail-on=empty"
          ]
        r `shouldBe` Left (ExitFailure 1)

    context "with --fail-on=focused" $ do
      let run = captureLines . ignoreExitCode . withArgs ["--fail-on=focused", "--seed", "23"] . H.hspec . removeLocations
      it "fails on focused spec items" $ do
        r <- run $ do
          H.it "foo" True
          H.fit "bar" True
        normalizeSummary r `shouldBe` [
            ""
          , "bar [✘]"
          , ""
          , "Failures:"
          , ""
          , "  1) bar"
          , "       item is focused; failing due to --fail-on=focused"
          , ""
          , "  To rerun use: --match \"/bar/\""
          , ""
          , "Randomized with seed 23"
          , ""
          , "Finished in 0.0000 seconds"
          , "1 example, 1 failure"
          ]

    context "with --fail-on=pending" $ do
      let run = captureLines . ignoreExitCode . withArgs ["--fail-on=pending", "--seed", "23"] . H.hspec . removeLocations
      it "fails on pending spec items" $ do
        r <- run $ do
          H.it "foo" True
          H.it "bar" $ do
            void $ throwIO (H.Pending Nothing Nothing)

        normalizeSummary r `shouldBe` [
            ""
          , "foo [✔]"
          , "bar [✘]"
          , ""
          , "Failures:"
          , ""
          , "  1) bar"
          , "       item is pending; failing due to --fail-on=pending"
          , ""
          , "  To rerun use: --match \"/bar/\""
          , ""
          , "Randomized with seed 23"
          , ""
          , "Finished in 0.0000 seconds"
          , "2 examples, 1 failure"
          ]

    context "with --fail-fast" $ do
      it "stops after first failure" $ do
        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec . removeLocations $ do
          H.it "foo" True
          H.it "bar" False
          H.it "baz" False
        normalizeSummary r `shouldBe` [
            ""
          , "foo [✔]"
          , "bar [✘]"
          , ""
          , "Failures:"
          , ""
          , "  1) bar"
          , ""
          , "  To rerun use: --match \"/bar/\""
          , ""
          , "Randomized with seed 23"
          , ""
          , "Finished in 0.0000 seconds"
          , "2 examples, 1 failure"
          ]

      it "cancels running parallel spec items on failure" $ do
        child1 <- newQSem 0
        child2 <- newQSem 0
        parent <- newQSem 0
        ref <- newIORef ""
        ignoreExitCode . hspec ["--fail-fast", "-j", "2"] $ do
          H.parallel $ do
            H.it "foo" $ do
              waitQSem child1
              "foo" `shouldBe` "bar"
            H.it "bar" $ do
              -- NOTE: waitQSem should never return here, as we want to
              -- guarantee that the thread is killed before hspec returns
              (signalQSem child1 >> waitQSem child2 >> writeIORef ref "foo") `finally` signalQSem parent
        signalQSem child2
        waitQSem parent
        readIORef ref `shouldReturn` ""

      it "works for nested specs" $ do
        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec . removeLocations $ do
          H.describe "foo" $ do
            H.it "bar" False
            H.it "baz" True
        normalizeSummary r `shouldBe` [
            ""
          , "foo"
          , "  bar [✘]"
          , ""
          , "Failures:"
          , ""
          , "  1) foo bar"
          , ""
          , "  To rerun use: --match \"/foo/bar/\""
          , ""
          , "Randomized with seed 23"
          , ""
          , "Finished in 0.0000 seconds"
          , "1 example, 1 failure"
          ]

    context "with --match" $ do
      it "only runs examples that match a given pattern" $ do
        e1 <- newMock
        e2 <- newMock
        e3 <- newMock
        hspec ["-m", "/bar/example"] $ do
          H.describe "foo" $ do
            H.describe "bar" $ do
              H.it "example 1" $ mockAction e1
              H.it "example 2" $ mockAction e2
            H.describe "baz" $ do
              H.it "example 3" $ mockAction e3
        (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 1, 0)

      it "only runs examples that match a given pattern (-m and --skip combined)" $ do
        e1 <- newMock
        e2 <- newMock
        e3 <- newMock
        e4 <- newMock
        hspec ["-m", "/bar/example", "--skip", "example 3"] $ do
          H.describe "foo" $ do
            H.describe "bar" $ do
              H.it "example 1" $ mockAction e1
              H.it "example 2" $ mockAction e2
              H.it "example 3" $ mockAction e3
            H.describe "baz" $ do
              H.it "example 4" $ mockAction e4
        (,,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 <*> mockCounter e4
          `shouldReturn` (1, 1, 0, 0)

      it "can be given multiple times" $ do
        e1 <- newMock
        e2 <- newMock
        e3 <- newMock
        hspec ["-m", "foo", "-m", "baz"] $ do
          H.describe "foo" $ do
            H.it "example 1" $ mockAction e1
          H.describe "bar" $ do
            H.it "example 2" $ mockAction e2
          H.describe "baz" $ do
            H.it "example 3" $ mockAction e3
        (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 0, 1)

#if __GLASGOW_HASKELL__ >= 802
    context "with --pretty" $ do
      it "pretty-prints Haskell values" $ do
        let args = ["--pretty", "--seed=0", "--format=failed-examples"]
        r <- fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec . removeLocations $ do
          H.it "foo" $ do
            person 23 `H.shouldBe` person 42
        r `shouldBe` unlines [
            ""
          , "Failures:"
          , ""
          , "  1) foo"
          , "       expected: Person {"
          , "                   personName = \"Joe\","
          , "                   personAge = 42"
          , "                 }"
          , "        but got: Person {"
          , "                   personName = \"Joe\","
          , "                   personAge = 23"
          , "                 }"
          , ""
          , "  To rerun use: --match \"/foo/\""
          , ""
          , "Randomized with seed 0"
          , ""
          , "Finished in 0.0000 seconds"
          , "1 example, 1 failure"
          ]
#endif

      it "uses custom pretty-print functions" $ do
        let pretty _ _ _ = ("foo", "bar")

        r <- capture_ . ignoreExitCode . withArgs ["--pretty"] . H.hspec $ do
          H.modifyConfig $ \ c -> c { H.configPrettyPrintFunction = pretty }
          H.it "foo" $ do
            23 `H.shouldBe` (42 :: Int)
        r `shouldContain` unlines [
            "       expected: foo"
          , "        but got: bar"
          ]

    context "with --no-pretty" $ do
      it "does not pretty-prints Haskell values" $ do
        r <- capture_ . ignoreExitCode . withArgs ["--no-pretty"] . H.hspec $ do
          H.it "foo" $ do
            person 23 `H.shouldBe` person 42
        r `shouldContain` unlines [
            "       expected: Person {personName = \"Joe\", personAge = 42}"
          , "        but got: Person {personName = \"Joe\", personAge = 23}"
          ]

    context "with --diff" $ do
      it "shows colorized diffs" $ do
        r <- capture_ . ignoreExitCode . withArgs ["--diff", "--color"] . H.hspec $ do
          H.it "foo" $ do
            23 `H.shouldBe` (42 :: Int)
        r `shouldContain` unlines [
            red ++ "       expected: " ++ reset ++ red ++ "42" ++ reset
          , red ++ "        but got: " ++ reset ++ green ++ "23" ++ reset
          ]

    context "with --no-diff" $ do
      it "it does not show colorized diffs" $ do
        r <- capture_ . ignoreExitCode . withArgs ["--no-diff", "--color"] . H.hspec $ do
          H.it "foo" $ do
            23 `H.shouldBe` (42 :: Int)
        r `shouldContain` unlines [
            red ++ "       expected: " ++ reset ++ "42"
          , red ++ "        but got: " ++ reset ++ "23"
          ]

    context "with --diff-context" $ do
      it "suppresses excessive diff output" $ do
        let
          args = ["--seed=0", "--format=failed-examples", "--diff-context=1"]
          expected = map show [1 .. 99 :: Int]
          actual = replace "50" "foo" expected
        r <- fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec . removeLocations $ do
          H.it "foo" $ do
            unlines actual `H.shouldBe` unlines expected
        r `shouldBe` unlines [
            ""
          , "Failures:"
          , ""
          , "  1) foo"
          , "       expected: @@ 48 lines omitted @@"
          , "                 49"
          , "                 50"
          , "                 51"
          , "                 @@ 48 lines omitted @@"
          , "                 "
          , "        but got: @@ 48 lines omitted @@"
          , "                 49"
          , "                 foo"
          , "                 51"
          , "                 @@ 48 lines omitted @@"
          , "                 "
          , ""
          , "  To rerun use: --match \"/foo/\""
          , ""
          , "Randomized with seed 0"
          , ""
          , "Finished in 0.0000 seconds"
          , "1 example, 1 failure"
          ]

    context "with --diff-command" $ do
      it "uses an external diff command" $ do
        let
          args = ["--seed=0", "--format=failed-examples", "--diff-command", "diff -u -L expected -L actual"]
          expected = map show [1 .. 99 :: Int]
          actual = replace "50" "foo" expected
        r <- fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec . removeLocations $ do
          H.it "foo" $ do
            unlines actual `H.shouldBe` unlines expected
        r `shouldBe` unlines [
            ""
          , "Failures:"
          , ""
          , "  1) foo"
          , "--- expected"
          , "+++ actual"
          , "@@ -47,7 +47,7 @@"
          , " 47"
          , " 48"
          , " 49"
          , "-50"
          , "+foo"
          , " 51"
          , " 52"
          , " 53"
          , ""
          , "  To rerun use: --match \"/foo/\""
          , ""
          , "Randomized with seed 0"
          , ""
          , "Finished in 0.0000 seconds"
          , "1 example, 1 failure"
          ]

    context "with --print-slow-items" $ do
      it "prints slow items" $ do
        r <- captureLines . ignoreExitCode . withArgs ["--print-slow-items"] . H.hspec $ do
          H.it "foo" $ threadDelay 2000
        normalizeTimes (normalizeSummary r) `shouldBe` [
            ""
          , "foo [✔]"
          , ""
          , "Finished in 0.0000 seconds"
          , "1 example, 0 failures"
          , ""
          , "Slow spec items:"
#if MIN_VERSION_base(4,8,1)
          , "  test" </> "Test" </> "Hspec" </> "Core" </> "RunnerSpec.hs:" <> show (__LINE__ - 10 :: Int) <> ":11: /foo/ (2ms)"
#else
          , "  /foo/ (2ms)"
#endif
          ]

    context "with --format" $ do
      it "uses specified formatter" $ do
        r <- capture_ . ignoreExitCode . withArgs ["--format", "progress"] . H.hspec $ do
          H.it "foo" True
          H.it "bar" True
          H.it "baz" False
          H.it "qux" True
        r `shouldContain` "..F."

      context "when given an invalid argument" $ do
        it "prints an error message to stderr" $ do
          r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--format", "foo"] . H.hspec $ do
            H.it "foo" True
          r `shouldContain` "invalid argument `foo' for `--format'"

    context "with --qc-max-success" $ do
      it "tries QuickCheck properties specified number of times" $ do
        m <- newMock
        hspec ["--qc-max-success", "23"] $ do
          H.it "foo" $ property $ \(_ :: Int) -> do
            mockAction m
        mockCounter m `shouldReturn` 23

      context "when run with --rerun" $ do
        it "takes precedence" $ do
          ["--qc-max-success", "23"] `shouldUseArgs` ((== 23) . QC.maxSuccess)
          ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` ((== 42) . QC.maxSuccess)

    context "with --qc-max-size" $ do
      it "passes specified size to QuickCheck properties" $ do
        ["--qc-max-size", "23"] `shouldUseArgs` ((== 23) . QC.maxSize)

    context "with --qc-max-discard" $ do
      it "uses specified discard ratio to QuickCheck properties" $ do
        ["--qc-max-discard", "23"] `shouldUseArgs` ((== 23) . QC.maxDiscardRatio)

    context "with --seed" $ do
      it "uses specified seed" $ do
        r <- runPropFoo ["--seed", "42"]
        runPropFoo ["--seed", "42"] `shouldReturn` r

      context "when run with --rerun" $ do
        it "takes precedence" $ do
          r <- runPropFoo ["--seed", "23"]
          _ <- runPropFoo ["--seed", "42"]
          runPropFoo ["--rerun", "--seed", "23"] `shouldReturn` r

      context "when given an invalid argument" $ do
        let run = withArgs ["--seed", "foo"] . H.hspec $ do
                    H.it "foo" True
        it "prints an error message to stderr" $ do
          r <- hCapture_ [stderr] (ignoreExitCode run)
          r `shouldContain` "invalid argument `foo' for `--seed'"

        it "exits with exitFailure" $ do
          hSilence [stderr] run `shouldThrow` (== ExitFailure 1)

    context "with --print-cpu-time" $ do
      it "includes used CPU time in summary" $ do
        r <- capture_ $ withArgs ["--print-cpu-time"] (H.hspec $ pure ())
        (normalizeSummary . lines) r `shouldContain` ["Finished in 0.0000 seconds, used 0.0000 seconds of CPU time"]

    context "with --html" $ do
      it "produces HTML output" $ do
        r <- capture_ . withArgs ["--html"] . H.hspec $ do
          H.it "foo" True
        r `shouldContain` "</span>"

      it "marks successful examples with CSS class hspec-success" $ do
        r <- capture_ . withArgs ["--html"] . H.hspec $ do
          H.it "foo" True
        r `shouldContain` "foo [<span class=\"hspec-success\">✔</span>]\n"

      it "marks pending examples with CSS class hspec-pending" $ do
        r <- capture_ . withArgs ["--html"] . H.hspec $ do
          H.it "foo" H.pending
        r `shouldContain` "foo [<span class=\"hspec-pending\">‐</span>]\n"

      it "marks failed examples with CSS class hspec-failure" $ do
        r <- capture_ . ignoreExitCode . withArgs ["--html"] . H.hspec $ do
          H.it "foo" False
        r `shouldContain` "foo [<span class=\"hspec-failure\">✘</span>]\n"

  describe "hspecResult" $ do
    let
      hspecResult args = withArgs ("--format=silent" : args) . H.hspecResult
      hspecResult_ = hspecResult []

    it "returns a summary of the test run" $ do
      hspecResult_ $ do
        H.it "foo" True
        H.it "foo" False
        H.it "foo" False
        H.it "foo" True
        H.it "foo" True
      `shouldReturn` H.Summary 5 2

    it "treats uncaught exceptions as failure" $ do
      hspecResult_  $ do
        H.it "foobar" throwException_
      `shouldReturn` H.Summary 1 1

    it "handles unguarded exceptions in runner" $ do
      let
        throwExceptionThatIsNotGuardedBy_safeTry :: H.Item () -> H.Item ()
        throwExceptionThatIsNotGuardedBy_safeTry item = item {
          H.itemExample = \ _params _hook _progress -> throwIO DivideByZero
        }
      hspecResult_ $ H.mapSpecItem_ throwExceptionThatIsNotGuardedBy_safeTry $ do
        H.it "foo" True
      `shouldReturn` H.Summary 1 1

    it "uses the specdoc formatter by default" $ do
      _:r:_ <- captureLines . H.hspecResult $ do
        H.describe "Foo.Bar" $ do
          H.it "some example" True
      r `shouldBe` "Foo.Bar"

    it "can use a custom formatter" $ do
      r <- capture_ . H.hspecWithResult H.defaultConfig {H.configFormat = Just $ V2.formatterToFormat V2.silent} $ do
        H.describe "Foo.Bar" $ do
          H.it "some example" True
      r `shouldBe` ""

    it "does not let escape error thunks from failure messages" $ do
      r <- hspecResult_ $ do
        H.it "some example" (H.Result "" $ H.Failure Nothing . H.Reason $ "foobar" ++ undefined)
      r `shouldBe` H.Summary 1 1

    it "runs specs in parallel" $ do
      let n = 100
          t = 0.01
          dt = t * (fromIntegral n / 2)
      r <- timeout dt . hspecResult ["-j", show n] . H.parallel $ do
        replicateM_ n (H.it "foo" $ sleep t)
      r `shouldBe` Just (H.Summary n 0)

    context "with -j" $ do
      it "limits parallelism" $ do
        currentRef <- newIORef (0 :: Int)
        highRef <- newIORef 0
        let n = 10
            t = 0.01
            j = 2
            start = do
              current <- atomicModifyIORef currentRef $ \x -> let y = succ x in (y, y)
              atomicModifyIORef highRef $ \x -> (max x current, ())
            stop = atomicModifyIORef currentRef $ \x -> (pred x, ())
        r <- hspecResult ["-j", show j] . H.parallel $ do
          replicateM_ n $ H.it "foo" $ bracket_ start stop $ sleep t
        r `shouldBe` H.Summary n 0
        high <- readIORef highRef
        high `shouldBe` j

  describe "colorOutputSupported" $ do

    context "without a terminal device" $ do

      let isTerminalDevice = return False

      it "returns False" $ do
        H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, False)

      context "with GITHUB_ACTIONS=true" $ do
        it "returns True" $ do
          withEnvironment [("GITHUB_ACTIONS", "true")] $ do
            H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, True)

    context "with a terminal device" $ do

      let isTerminalDevice = return True

      it "returns True" $ do
        H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (True, True)

      context "with BUILDKITE=true" $ do
        it "disables progress reporting" $ do
          withEnvironment [("BUILDKITE", "true")] $ do
            H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, True)

      context "when NO_COLOR is set" $ do
        it "returns False" $ do
          withEnvironment [("NO_COLOR", "yes")] $ do
            H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, False)

  describe "unicodeOutputSupported" $ do
    context "with UnicodeAlways" $ do
      it "returns True" $ do
        H.unicodeOutputSupported H.UnicodeAlways undefined `shouldReturn` True

    context "with UnicodeNever" $ do
      it "returns False" $ do
        H.unicodeOutputSupported H.UnicodeNever undefined `shouldReturn` False

    context "with UnicodeAuto" $ do
      context "when file encoding is UTF-8" $ do
        it "returns True" $ do
          inTempDirectory $ do
            withFile "foo" WriteMode $ \ h -> do
              hSetEncoding h utf8
              H.unicodeOutputSupported H.UnicodeAuto h `shouldReturn` True

      context "when file encoding is not UTF-8" $ do
        it "returns False" $ do
          inTempDirectory $ do
            withFile "foo" WriteMode $ \ h -> do
              hSetEncoding h latin1
              H.unicodeOutputSupported H.UnicodeAuto h `shouldReturn` False

  describe "rerunAll" $ do
    let
      report = FailureReport 0 0 0 0 [([], "foo")]
      config = H.defaultConfig {H.configRerun = True, H.configRerunAllOnSuccess = True}
      result = SpecResult [] True
    context "with --rerun, --rerun-all-on-success, previous failures, on success" $ do
      it "returns True" $ do
        H.rerunAll config (Just report) result `shouldBe` True

    context "without --rerun" $ do
      it "returns False" $ do
        H.rerunAll config {H.configRerun = False} (Just report) result `shouldBe` False

    context "without --rerun-all-on-success" $ do
      it "returns False" $ do
        H.rerunAll config {H.configRerunAllOnSuccess = False} (Just report) result `shouldBe` False

    context "without previous failures" $ do
      it "returns False" $ do
        H.rerunAll config (Just report {failureReportPaths = []}) result `shouldBe` False

    context "without failure report" $ do
      it "returns False" $ do
        H.rerunAll config Nothing result `shouldBe` False

    context "on failure" $ do
      it "returns False" $ do
        H.rerunAll config (Just report) result { specResultSuccess = False } `shouldBe` False
  where
    green  = setSGRCode [SetColor Foreground Dull Green]
    red    = setSGRCode [SetColor Foreground Dull Red]
    reset  = setSGRCode [Reset]