    {-# 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 = HUnitFailure -> IO a
    forall e a. (HasCallStack, 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 [(String, SrcLoc)] -> [(String, SrcLoc)]
    forall a. [a] -> [a]
    reverse [(String, SrcLoc)]
    HasCallStack => [(String, SrcLoc)]
    callStack of
          (String
    _, SrcLoc
    loc) : [(String, SrcLoc)]
    _ -> SrcLoc -> Maybe SrcLoc
    forall a. a -> Maybe a
    Just SrcLoc
    loc
          [] -> Maybe SrcLoc
    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 = Bool -> Assertion -> Assertion
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    b (String -> Assertion
    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 =
      Bool -> Assertion -> Assertion
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (a
    actual a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    expected) (String -> Assertion
    forall a. HasCallStack => String -> IO a
    assertFailure String
    msg)
     where msg :: String
    msg = (if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    preface then String
    "" else String
    preface String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                 String
    "expected: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    expected String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n but got: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    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 = String -> a -> a -> Assertion
    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 = String -> a -> a -> Assertion
    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 = t -> IO Bool
    forall t. AssertionPredicable t => t -> IO Bool
    assertionPredicate t
    predi IO Bool -> (Bool -> Assertion) -> Assertion
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= HasCallStack => String -> Bool -> Assertion
    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 = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

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

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

    prependLocation :: Maybe SrcLoc -> String -> String
    prependLocation :: Maybe SrcLoc -> String -> String
    prependLocation Maybe SrcLoc
    mbloc String
    s =
      case Maybe SrcLoc
    mbloc of
        Maybe SrcLoc
    Nothing -> String
    s
        Just SrcLoc
    loc -> SrcLoc -> String
    srcLocFile SrcLoc
    loc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (SrcLoc -> Int
    srcLocStartLine SrcLoc
    loc) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":\n" String -> String -> String
    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 = Bool -> Assertion -> Assertion
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s) (String -> Assertion
    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 = () -> Assertion
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

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

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

    instance Assertable String
     where assert :: String -> Assertion
    assert = HasCallStack => String -> Assertion
    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