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

{-# LANGUAGE PackageImports #-}

-- | HUnit support for tasty.
--
-- We don't use `tasty-hunit` directly because it doesn't interoperate properly
-- with other HUnit-based code.
-- Specifically, it defines its own `HUnitFailure` type and catches exceptions
-- of this type. It doesn't catch HUnit's `HUnitFailure`, so they are not
-- pretty-printed.

module Test.Tasty.HUnit
  ( testCase
  , testCaseInfo
  , testCaseSteps

    -- * Re-exports
  , HUnit.assertFailure
  , HUnit.assertBool
  , HUnit.assertEqual
  , (HUnit.@=?)
  , (HUnit.@?=)
  , (HUnit.@?)
  , HUnit.AssertionPredicable(..)
  , HUnit.Assertion
  , HUnit.HUnitFailure
  , HasCallStack
  ) where

import Control.Exception (handle, throwIO)
import GHC.Stack (HasCallStack)
import Test.HUnit (Assertion)
import qualified Test.HUnit as HUnit
import qualified Test.HUnit.Lang as HUnit
import Test.Tasty (TestName, TestTree)
import qualified "tasty-hunit" Test.Tasty.HUnit as Tasty.HUnit

-- | Turn @HUnit@ assertion into @Tasty.HUnit@ one.
adjustSuite :: IO a -> IO a
adjustSuite :: IO a -> IO a
adjustSuite =
  -- All we need is to modify thrown exception
  (HUnitFailure -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((HUnitFailure -> IO a) -> IO a -> IO a)
-> (HUnitFailure -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ \(HUnit.HUnitFailure Maybe SrcLoc
mloc FailureReason
reason) ->
    let reason' :: String
reason' = (FailureReason -> String
HUnit.formatFailureReason FailureReason
reason)
    in HUnitFailure -> IO a
forall e a. Exception e => e -> IO a
throwIO (HUnitFailure -> IO a) -> HUnitFailure -> IO a
forall a b. (a -> b) -> a -> b
$ Maybe SrcLoc -> String -> HUnitFailure
Tasty.HUnit.HUnitFailure Maybe SrcLoc
mloc String
reason'

-- | Turn an 'Assertion' into a tasty test case
testCase :: TestName -> Assertion -> TestTree
testCase :: String -> Assertion -> TestTree
testCase String
name = String -> Assertion -> TestTree
Tasty.HUnit.testCase String
name (Assertion -> TestTree)
-> (Assertion -> Assertion) -> Assertion -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> Assertion
forall a. IO a -> IO a
adjustSuite

testCaseInfo :: TestName -> IO String -> TestTree
testCaseInfo :: String -> IO String -> TestTree
testCaseInfo String
name = String -> IO String -> TestTree
Tasty.HUnit.testCaseInfo String
name (IO String -> TestTree)
-> (IO String -> IO String) -> IO String -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO String -> IO String
forall a. IO a -> IO a
adjustSuite

testCaseSteps :: TestName -> ((String -> IO ()) -> Assertion) -> TestTree
testCaseSteps :: String -> ((String -> Assertion) -> Assertion) -> TestTree
testCaseSteps String
name (String -> Assertion) -> Assertion
f = String -> ((String -> Assertion) -> Assertion) -> TestTree
Tasty.HUnit.testCaseSteps String
name (\String -> Assertion
step -> Assertion -> Assertion
forall a. IO a -> IO a
adjustSuite (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ (String -> Assertion) -> Assertion
f String -> Assertion
step)