{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Test.Hspec.Core.Formatters.V1Spec (spec) where

import           Prelude ()
import           Helper hiding (colorize)
import           Data.String
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Writer hiding (pass)

import qualified Test.Hspec.Core.Spec as H
import qualified Test.Hspec.Core.Runner as H
import qualified Test.Hspec.Core.Formatters.V1 as H hiding (FailureReason(..))
import qualified Test.Hspec.Core.Formatters.V1.Monad as H (interpretWith)
import           Test.Hspec.Core.Formatters.V1.Monad (FormatM, Environment(..), FailureRecord(..), FailureReason(..))

data ColorizedText =
    Plain String
  | Transient String
  | Info String
  | Succeeded String
  | Failed String
  | Pending String
  | Extra String
  | Missing String
  deriving (Eq, Show)

instance IsString ColorizedText where
  fromString = Plain

removeColors :: [ColorizedText] -> String
removeColors input = case input of
  Plain x : xs -> x ++ removeColors xs
  Transient _ : xs -> removeColors xs
  Info x : xs -> x ++ removeColors xs
  Succeeded x : xs -> x ++ removeColors xs
  Failed x : xs -> x ++ removeColors xs
  Pending x : xs -> x ++ removeColors xs
  Extra x : xs -> x ++ removeColors xs
  Missing x : xs -> x ++ removeColors xs
  [] -> ""

simplify :: [ColorizedText] -> [ColorizedText]
simplify input = case input of
  Plain xs : Plain ys : zs -> simplify (Plain (xs ++ ys) : zs)
  Extra xs : Extra ys : zs -> simplify (Extra (xs ++ ys) : zs)
  Missing xs : Missing ys : zs -> simplify (Missing (xs ++ ys) : zs)
  x : xs -> x : simplify xs
  [] -> []

colorize :: (String -> ColorizedText) -> [ColorizedText] -> [ColorizedText]
colorize color input = case simplify input of
  Plain x : xs -> color x : xs
  xs -> xs

interpret :: FormatM a -> IO [ColorizedText]
interpret = interpretWith environment

interpretWith :: Environment (WriterT [ColorizedText] IO) -> FormatM a -> IO [ColorizedText]
interpretWith env = fmap simplify . execWriterT . H.interpretWith env

environment :: Environment (WriterT [ColorizedText] IO)
environment = Environment {
  environmentGetSuccessCount = return 0
, environmentGetPendingCount = return 0
, environmentGetFailMessages = return []
, environmentUsedSeed = return 0
, environmentGetCPUTime = return Nothing
, environmentGetRealTime = return 0
, environmentWrite = tell . return . Plain
, environmentWriteTransient = tell . return . Transient
, environmentWithFailColor = \ action -> do
    (a, r) <- liftIO $ runWriterT action
    tell (colorize Failed r) >> return a
, environmentWithSuccessColor = \ action -> do
    (a, r) <- liftIO $ runWriterT action
    tell (colorize Succeeded r) >> return a
, environmentWithPendingColor = \ action -> do
    (a, r) <- liftIO $ runWriterT action
    tell (colorize Pending r) >> return a
, environmentWithInfoColor = \ action -> do
    (a, r) <- liftIO $ runWriterT action
    tell (colorize Info r) >> return a
, environmentUseDiff = return True
, environmentPrintTimes = return False
, environmentExtraChunk = tell . return . Extra
, environmentMissingChunk = tell . return . Missing
, environmentLiftIO = liftIO
}

testSpec :: H.Spec
testSpec = do
  H.describe "Example" $ do
    H.it "success"    (H.Result "" H.Success)
    H.it "fail 1"     (H.Result "" $ H.Failure Nothing $ H.Reason "fail message")
    H.it "pending"    (H.pendingWith "pending message")
    H.it "fail 2"     (H.Result "" $ H.Failure Nothing H.NoReason)
    H.it "exceptions" (undefined :: H.Result)
    H.it "fail 3"     (H.Result "" $ H.Failure Nothing H.NoReason)

spec :: Spec
spec = do
  describe "progress" $ do
    let formatter = H.progress

    describe "exampleSucceeded" $ do
      it "marks succeeding examples with ." $ do
        interpret (H.exampleSucceeded formatter undefined undefined) `shouldReturn` [
            Succeeded "."
          ]

    describe "exampleFailed" $ do
      it "marks failing examples with F" $ do
        interpret (H.exampleFailed formatter undefined undefined undefined) `shouldReturn` [
            Failed "F"
          ]

    describe "examplePending" $ do
      it "marks pending examples with ." $ do
        interpret (H.examplePending formatter undefined undefined undefined) `shouldReturn` [
            Pending "."
          ]

  describe "specdoc" $ do
    let
      formatter = H.specdoc
      runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just formatter}

    it "displays a header for each thing being described" $ do
      _:x:_ <- runSpec testSpec
      x `shouldBe` "Example"

    it "displays one row for each behavior" $ do
      r <- runSpec $ do
        H.describe "List as a Monoid" $ do
          H.describe "mappend" $ do
            H.it "is associative" True
          H.describe "mempty" $ do
            H.it "is a left identity" True
            H.it "is a right identity" True
        H.describe "Maybe as a Monoid" $ do
          H.describe "mappend" $ do
            H.it "is associative" True
          H.describe "mempty" $ do
            H.it "is a left identity" True
            H.it "is a right identity" True
      normalizeSummary r `shouldBe` [
          ""
        , "List as a Monoid"
        , "  mappend"
        , "    is associative"
        , "  mempty"
        , "    is a left identity"
        , "    is a right identity"
        , "Maybe as a Monoid"
        , "  mappend"
        , "    is associative"
        , "  mempty"
        , "    is a left identity"
        , "    is a right identity"
        , ""
        , "Finished in 0.0000 seconds"
        , "6 examples, 0 failures"
        ]

    it "outputs an empty line at the beginning (even for non-nested specs)" $ do
      r <- runSpec $ do
        H.it "example 1" True
        H.it "example 2" True
      normalizeSummary r `shouldBe` [
          ""
        , "example 1"
        , "example 2"
        , ""
        , "Finished in 0.0000 seconds"
        , "2 examples, 0 failures"
        ]

    it "displays a row for each successful, failed, or pending example" $ do
      r <- runSpec testSpec
      r `shouldSatisfy` any (== "  fail 1 FAILED [1]")
      r `shouldSatisfy` any (== "  success")

    it "displays a '#' with an additional message for pending examples" $ do
      r <- runSpec testSpec
      r `shouldSatisfy` any (== "    # PENDING: pending message")

    context "with an empty group" $ do
      it "omits that group from the report" $ do
        r <- runSpec $ do
          H.describe "foo" $ do
            H.it "example 1" True
          H.describe "bar" $ do
            pass
          H.describe "baz" $ do
            H.it "example 2" True

        normalizeSummary r `shouldBe` [
            ""
          , "foo"
          , "  example 1"
          , "baz"
          , "  example 2"
          , ""
          , "Finished in 0.0000 seconds"
          , "2 examples, 0 failures"
          ]

    describe "failedFormatter" $ do
      let action = H.failedFormatter formatter

      context "when actual/expected contain newlines" $ do
        let
          env = environment {
            environmentGetFailMessages = return [FailureRecord Nothing ([], "") (ExpectedButGot Nothing "first\nsecond\nthird" "first\ntwo\nthird")]
            }
        it "adds indentation" $ do
          (removeColors <$> interpretWith env action) `shouldReturn` unlines [
              ""
            , "Failures:"
            , ""
            , "  1) "
            , "       expected: first"
            , "                 second"
            , "                 third"
            , "        but got: first"
            , "                 two"
            , "                 third"
            , ""
            , "  To rerun use: --match \"//\""
            , ""
            , "Randomized with seed 0"
            , ""
            ]

    describe "footerFormatter" $ do
      let action = H.footerFormatter formatter

      context "without failures" $ do
        let env = environment {environmentGetSuccessCount = return 1}
        it "shows summary in green if there are no failures" $ do
          interpretWith env action `shouldReturn` [
              "Finished in 0.0000 seconds\n"
            , Succeeded "1 example, 0 failures\n"
            ]

      context "with pending examples" $ do
        let env = environment {environmentGetPendingCount = return 1}
        it "shows summary in yellow if there are pending examples" $ do
          interpretWith env action `shouldReturn` [
              "Finished in 0.0000 seconds\n"
            , Pending "1 example, 0 failures, 1 pending\n"
            ]

      context "with failures" $ do
        let env = environment {environmentGetFailMessages = return [undefined]}
        it "shows summary in red" $ do
          interpretWith env action `shouldReturn` [
              "Finished in 0.0000 seconds\n"
            , Failed "1 example, 1 failure\n"
            ]

      context "with both failures and pending examples" $ do
        let env = environment {environmentGetFailMessages = return [undefined], environmentGetPendingCount = return 1}
        it "shows summary in red" $ do
          interpretWith env action `shouldReturn` [
              "Finished in 0.0000 seconds\n"
            , Failed "2 examples, 1 failure, 1 pending\n"
            ]

    context "same as failed_examples" $ do
      failed_examplesSpec formatter

failed_examplesSpec :: H.Formatter -> Spec
failed_examplesSpec formatter = do
  let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just formatter}

  context "displays a detailed list of failures" $ do
    it "prints all requirements that are not met" $ do
      r <- runSpec testSpec
      r `shouldSatisfy` any (== "  1) Example fail 1")

    it "prints the exception type for requirements that fail due to an uncaught exception" $ do
      r <- runSpec $ do
        H.it "foobar" (throw (ErrorCall "baz") :: Bool)
      r `shouldContain` [
          "  1) foobar"
        , "       uncaught exception: ErrorCall"
        , "       baz"
        ]

    it "prints all descriptions when a nested requirement fails" $ do
      r <- runSpec $
        H.describe "foo" $ do
          H.describe "bar" $ do
            H.it "baz" False
      r `shouldSatisfy` any (== "  1) foo.bar baz")


    context "when a failed example has a source location" $ do
      it "includes that source location above the error message" $ do
        let loc = H.Location "test/FooSpec.hs" 23 4
            addLoc e = e {H.itemLocation = Just loc}
        r <- runSpec $ H.mapSpecItem_ addLoc $ do
          H.it "foo" False
        r `shouldContain` ["  test/FooSpec.hs:23:4: ", "  1) foo"]