Report.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module TestSuite.Cleveland.Tasty.Report
  ( test_formatError
  , unit_formatError_fails_gracefully_when_callstack_loc_points_to_another_package
  ) where

import Data.Char (isSpace)
import qualified Data.Text as Text
import Fmt (build, indentF, pretty, unlinesF)
import GHC.Stack (SrcLoc(..), fromCallSiteList)
import System.FilePath ((</>))
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.Options (singleOption)
import Test.Tasty.Runners (Result(resultDescription))

import Test.Cleveland
import Test.Cleveland.Tasty.Internal.Options (ContextLinesOpt(ContextLinesOpt))
import Test.Cleveland.Tasty.Internal.Report (formatError)

import TestSuite.Cleveland.Tasty.Report.Examples (reportExamples)
import TestSuite.Util (runViaTastyOnEmulator)

test_formatError :: TestTree
test_formatError =
  testGroup "formatError" $
    fmap checkResultDescription reportExamples

checkResultDescription :: (TestName, EmulatedT PureM (), Text) -> TestTree
checkResultDescription (testName, scenario', expectedErr) =
  runViaTastyOnEmulator testName (singleOption (ContextLinesOpt 1)) scenario' \tastyResult -> do
    let
      -- Some error lines might have trailing whitespace, we can ignore it here.
      strippedErr =
        lines (toText $ resultDescription tastyResult)
        & fmap (Text.dropWhileEnd isSpace)
        & unlines

    unless (expectedErr `Text.isPrefixOf` strippedErr) $
      assertFailure $
        pretty $ unlinesF
          [ "Expected the report to start with:"
          , indentF 4 $ build expectedErr
          , "But got:"
          , indentF 4 $ build strippedErr
          ]


unit_formatError_fails_gracefully_when_callstack_loc_points_to_another_package :: Assertion
unit_formatError_fails_gracefully_when_callstack_loc_points_to_another_package = do
  builder <-
    formatError
      1
      (fromCallSiteList
        [ ("expectCustomError_"
          , SrcLoc
              { srcLocPackage = "pkg"
              , srcLocModule = "Module"
              , srcLocFile = "src" </> "invalid" </> "path"
              , srcLocStartLine = 1, srcLocStartCol = 1, srcLocEndLine = 1, srcLocEndCol = 1
              }
          )
        ]
      )
      "err msg"

  pretty builder @?=
    unlines
      [ "err msg"
      , ""
      , "CallStack (from HasCallStack):"
      , toText ("  expectCustomError_, called at src" </> "invalid" </> "path:1:1 in pkg:Module")
      ]