{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-}

-- required for HasCallStack by different versions of GHC
{-# LANGUAGE ConstraintKinds, FlexibleContexts #-}

-- | This is the code copied from the original hunit package (v. 1.2.5.2).
-- with minor modifications
module Test.Tasty.HUnit.Orig where

import qualified Control.Exception as E
import Control.Monad
import Data.Typeable (Typeable)
import Data.CallStack

-- Interfaces
-- ----------

-- | An assertion is simply an 'IO' action. Assertion failure is indicated
-- by throwing an exception, typically 'HUnitFailure'.
--
-- Instead of throwing the exception directly, you should use
-- functions like 'assertFailure' and 'assertBool'.
--
-- Test cases are composed of a sequence of one or more assertions.

type Assertion = IO ()

-- | Unconditionally signals that a failure has occured.  All
-- other assertions can be expressed with the form:
--
-- @
--    if conditionIsMet
--        then return ()
--        else assertFailure msg
-- @

assertFailure
  :: HasCallStack
  => String -- ^ A message that is displayed with the assertion failure
  -> IO a
assertFailure :: forall a. HasCallStack => String -> IO a
assertFailure String
msg = forall e a. Exception e => e -> IO a
E.throwIO (Maybe SrcLoc -> String -> HUnitFailure
HUnitFailure Maybe SrcLoc
location String
msg)
  where
    location :: Maybe SrcLoc
    location :: Maybe SrcLoc
location = case forall a. [a] -> [a]
reverse HasCallStack => CallStack
callStack of
      (String
_, SrcLoc
loc) : CallStack
_ -> forall a. a -> Maybe a
Just SrcLoc
loc
      [] -> forall a. Maybe a
Nothing

-- Conditional Assertion Functions
-- -------------------------------

-- | Asserts that the specified condition holds.
assertBool
  :: HasCallStack
  => String    -- ^ The message that is displayed if the assertion fails
  -> Bool      -- ^ The condition
  -> Assertion
assertBool :: HasCallStack => String -> Bool -> Assertion
assertBool String
msg Bool
b = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (forall a. HasCallStack => String -> IO a
assertFailure String
msg)

-- | Asserts that the specified actual value is equal to the expected value.
-- The output message will contain the prefix, the expected value, and the
-- actual value.
--
-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted
-- and only the expected and actual values are output.
assertEqual
  :: (Eq a, Show a, HasCallStack)
  => String -- ^ The message prefix
  -> a      -- ^ The expected value
  -> a      -- ^ The actual value
  -> Assertion
assertEqual :: forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
preface a
expected a
actual =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual forall a. Eq a => a -> a -> Bool
== a
expected) (forall a. HasCallStack => String -> IO a
assertFailure String
msg)
 where msg :: String
msg = (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
preface then String
"" else String
preface forall a. [a] -> [a] -> [a]
++ String
"\n") forall a. [a] -> [a] -> [a]
++
             String
"expected: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
expected forall a. [a] -> [a] -> [a]
++ String
"\n but got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
actual

infix  1 @?, @=?, @?=

-- | Asserts that the specified actual value is equal to the expected value
--   (with the expected value on the left-hand side).
(@=?)
  :: (Eq a, Show a, HasCallStack)
  => a -- ^ The expected value
  -> a -- ^ The actual value
  -> Assertion
a
expected @=? :: forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? a
actual = forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"" a
expected a
actual

-- | Asserts that the specified actual value is equal to the expected value
--   (with the actual value on the left-hand side).
(@?=)
  :: (Eq a, Show a, HasCallStack)
  => a -- ^ The actual value
  -> a -- ^ The expected value
  -> Assertion
a
actual @?= :: forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= a
expected = forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"" a
expected a
actual

-- | An infix and flipped version of 'assertBool'. E.g. instead of
--
-- >assertBool "Non-empty list" (null [1])
--
-- you can write
--
-- >null [1] @? "Non-empty list"
--
-- '@?' is also overloaded to accept @'IO' 'Bool'@ predicates, so instead
-- of
--
-- > do
-- >   e <- doesFileExist "test"
-- >   e @? "File does not exist"
--
-- you can write
--
-- > doesFileExist "test" @? "File does not exist"
(@?) :: (AssertionPredicable t, HasCallStack)
  => t          -- ^ A value of which the asserted condition is predicated
  -> String     -- ^ A message that is displayed if the assertion fails
  -> Assertion
t
predi @? :: forall t.
(AssertionPredicable t, HasCallStack) =>
t -> String -> Assertion
@? String
msg = forall t. AssertionPredicable t => t -> IO Bool
assertionPredicate t
predi forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
assertBool String
msg

-- | An ad-hoc class used to overload the '@?' operator.
--
-- The only intended instances of this class are @'Bool'@ and @'IO' 'Bool'@.
--
-- You shouldn't need to interact with this class directly.
class AssertionPredicable t
 where assertionPredicate :: t -> IO Bool

instance AssertionPredicable Bool
 where assertionPredicate :: Bool -> IO Bool
assertionPredicate = forall (m :: * -> *) a. Monad m => a -> m a
return

instance (AssertionPredicable t) => AssertionPredicable (IO t)
 where assertionPredicate :: IO t -> IO Bool
assertionPredicate = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t. AssertionPredicable t => t -> IO Bool
assertionPredicate)


-- | Exception thrown by 'assertFailure' etc.
data HUnitFailure = HUnitFailure (Maybe SrcLoc) String
    deriving (HUnitFailure -> HUnitFailure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HUnitFailure -> HUnitFailure -> Bool
$c/= :: HUnitFailure -> HUnitFailure -> Bool
== :: HUnitFailure -> HUnitFailure -> Bool
$c== :: HUnitFailure -> HUnitFailure -> Bool
Eq, Int -> HUnitFailure -> ShowS
[HUnitFailure] -> ShowS
HUnitFailure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HUnitFailure] -> ShowS
$cshowList :: [HUnitFailure] -> ShowS
show :: HUnitFailure -> String
$cshow :: HUnitFailure -> String
showsPrec :: Int -> HUnitFailure -> ShowS
$cshowsPrec :: Int -> HUnitFailure -> ShowS
Show, Typeable)
instance E.Exception HUnitFailure where
  displayException :: HUnitFailure -> String
displayException (HUnitFailure Maybe SrcLoc
mbloc String
s) = Maybe SrcLoc -> ShowS
prependLocation Maybe SrcLoc
mbloc String
s

prependLocation :: Maybe SrcLoc -> String -> String
prependLocation :: Maybe SrcLoc -> ShowS
prependLocation Maybe SrcLoc
mbloc String
s =
  case Maybe SrcLoc
mbloc of
    Maybe SrcLoc
Nothing -> String
s
    Just SrcLoc
loc -> SrcLoc -> String
srcLocFile SrcLoc
loc forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SrcLoc -> Int
srcLocStartLine SrcLoc
loc) forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String
s

----------------------------------------------------------------------
--                          DEPRECATED CODE
----------------------------------------------------------------------

{-# DEPRECATED assertString "Why not use assertBool instead?" #-}
{-# DEPRECATED Assertable, AssertionPredicate
   "This class or type seems dubious. If you have a good use case for it, please create an issue for tasty. Otherwise, it may be removed in a future version." #-}

-- | Signals an assertion failure if a non-empty message (i.e., a message
-- other than @\"\"@) is passed.
assertString
  :: HasCallStack
  => String    -- ^ The message that is displayed with the assertion failure
  -> Assertion
assertString :: HasCallStack => String -> Assertion
assertString String
s = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) (forall a. HasCallStack => String -> IO a
assertFailure String
s)

-- Overloaded `assert` Function
-- ----------------------------

-- | Allows the extension of the assertion mechanism.
--
-- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions,
-- there is a fair amount of flexibility of what can be achieved.  As a rule,
-- the resulting @Assertion@ should be the body of a @TestCase@ or part of
-- a @TestCase@; it should not be used to assert multiple, independent
-- conditions.
--
-- If more complex arrangements of assertions are needed, @Test@ and
-- @Testable@ should be used.
class Assertable t
 where assert :: t -> Assertion

instance Assertable ()
 where assert :: () -> Assertion
assert = forall (m :: * -> *) a. Monad m => a -> m a
return

instance Assertable Bool
 where assert :: Bool -> Assertion
assert = HasCallStack => String -> Bool -> Assertion
assertBool String
""

instance (Assertable t) => Assertable (IO t)
 where assert :: IO t -> Assertion
assert = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t. Assertable t => t -> Assertion
assert)

instance Assertable String
 where assert :: String -> Assertion
assert = HasCallStack => String -> Assertion
assertString


-- Overloaded `assertionPredicate` Function
-- ----------------------------------------

-- | The result of an assertion that hasn't been evaluated yet.
--
-- Most test cases follow the following steps:
--
-- 1. Do some processing or an action.
--
-- 2. Assert certain conditions.
--
-- However, this flow is not always suitable.  @AssertionPredicate@ allows for
-- additional steps to be inserted without the initial action to be affected
-- by side effects.  Additionally, clean-up can be done before the test case
-- has a chance to end.  A potential work flow is:
--
-- 1. Write data to a file.
--
-- 2. Read data from a file, evaluate conditions.
--
-- 3. Clean up the file.
--
-- 4. Assert that the side effects of the read operation meet certain conditions.
--
-- 5. Assert that the conditions evaluated in step 2 are met.
type AssertionPredicate = IO Bool