module Test.Chell.HUnit (hunit) where

import qualified Test.Chell as Chell
import Test.HUnit.Lang (Assertion, Result (..), performTestCase)

-- | Convert a sequence of HUnit assertions (embedded in IO) to a Chell
-- 'Chell.Test'.
--
-- @
-- import Test.Chell
-- import Test.Chell.HUnit
-- import Test.HUnit
--
-- test_Addition :: Test
-- test_addition = hunit \"addition\" $ do
--    1 + 2 \@?= 3
--    2 + 3 \@?= 5
-- @
hunit :: String -> Assertion -> Chell.Test
hunit :: String -> Assertion -> Test
hunit String
name Assertion
io = String -> (TestOptions -> IO TestResult) -> Test
Chell.test String
name forall {p}. p -> IO TestResult
chell_io
  where
    chell_io :: p -> IO TestResult
chell_io p
_ =
      do
        Result
result <- Assertion -> IO Result
performTestCase Assertion
io
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          case Result
result of
            Result
Success -> [(String, String)] -> TestResult
Chell.TestPassed []
            Failure Maybe SrcLoc
_ String
msg ->
              [(String, String)] -> [Failure] -> TestResult
Chell.TestFailed
                []
                [Failure
Chell.failure {failureMessage :: String
Chell.failureMessage = String
msg}]
            Error Maybe SrcLoc
_ String
msg -> [(String, String)] -> String -> TestResult
Chell.TestAborted [] String
msg