    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE FlexibleContexts #-}

    #if __GLASGOW_HASKELL__ >= 704
    {-# LANGUAGE ConstraintKinds #-}
    #define HasCallStack_ HasCallStack =>
    #else
    #define HasCallStack_
    #endif

    module Test.HUnit.Lang (
      Assertion,
      assertFailure,
      assertEqual,

      Result (..),
      performTestCase,
    -- * Internals
    -- |
    -- /Note:/ This is not part of the public API!  It is exposed so that you can
    -- tinker with the internals of HUnit, but do not expect it to be stable!
      HUnitFailure (..),
      FailureReason (..),
      formatFailureReason
    ) where

    import           Control.DeepSeq
    import           Control.Exception as E
    import           Control.Monad
    import           Data.List
    import           Data.Typeable
    import           Data.CallStack

    -- | When an assertion is evaluated, it will output a message if and only if the
    -- assertion fails.
    --
    -- Test cases are composed of a sequence of one or more assertions.
    type Assertion = IO ()

    data HUnitFailure = HUnitFailure (Maybe SrcLoc) FailureReason
        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 -> ShowS
    [HUnitFailure] -> ShowS
    HUnitFailure -> String
    (Int -> HUnitFailure -> ShowS)
    -> (HUnitFailure -> String)
    -> ([HUnitFailure] -> ShowS)
    -> Show HUnitFailure
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HUnitFailure -> ShowS
    showsPrec :: Int -> HUnitFailure -> ShowS
    $cshow :: HUnitFailure -> String
    show :: HUnitFailure -> String
    $cshowList :: [HUnitFailure] -> ShowS
    showList :: [HUnitFailure] -> ShowS
    Show, Typeable)

    instance Exception HUnitFailure

    data FailureReason = Reason String | ExpectedButGot (Maybe String) String String
        deriving (FailureReason -> FailureReason -> Bool
    (FailureReason -> FailureReason -> Bool)
    -> (FailureReason -> FailureReason -> Bool) -> Eq FailureReason
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FailureReason -> FailureReason -> Bool
    == :: FailureReason -> FailureReason -> Bool
    $c/= :: FailureReason -> FailureReason -> Bool
    /= :: FailureReason -> FailureReason -> Bool
    Eq, Int -> FailureReason -> ShowS
    [FailureReason] -> ShowS
    FailureReason -> String
    (Int -> FailureReason -> ShowS)
    -> (FailureReason -> String)
    -> ([FailureReason] -> ShowS)
    -> Show FailureReason
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FailureReason -> ShowS
    showsPrec :: Int -> FailureReason -> ShowS
    $cshow :: FailureReason -> String
    show :: FailureReason -> String
    $cshowList :: [FailureReason] -> ShowS
    showList :: [FailureReason] -> ShowS
    Show, Typeable)

    location :: HasCallStack_ Maybe SrcLoc
    location :: HasCallStack => 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

    -- | Unconditionally signals that a failure has occurred.
    assertFailure ::
         HasCallStack_
         String -- ^ A message that is displayed with the assertion failure
      -> IO a
    assertFailure :: forall a. HasCallStack => String -> IO a
    assertFailure String
    msg = String
    msg String -> IO a -> IO a
    forall a b. NFData a => a -> b -> b
    `deepseq` HUnitFailure -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (Maybe SrcLoc -> FailureReason -> HUnitFailure
    HUnitFailure Maybe SrcLoc
    HasCallStack => Maybe SrcLoc
    location (FailureReason -> HUnitFailure) -> FailureReason -> HUnitFailure
    forall a b. (a -> b) -> a -> b
    $ String -> FailureReason
    Reason 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 :: HasCallStack_ (Eq a, Show a)
                                  => String -- ^ The message prefix
                                  -> a      -- ^ The expected value
                                  -> a      -- ^ The actual value
                                  -> Assertion
    assertEqual :: forall a.
    (HasCallStack, Eq a, Show a) =>
    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) (Assertion -> Assertion) -> Assertion -> Assertion
    forall a b. (a -> b) -> a -> b
    $ do
        (Maybe String
    prefaceMsg Maybe String -> Assertion -> Assertion
    forall a b. NFData a => a -> b -> b
    `deepseq` String
    expectedMsg String -> Assertion -> Assertion
    forall a b. NFData a => a -> b -> b
    `deepseq` String
    actualMsg String -> Assertion -> Assertion
    forall a b. NFData a => a -> b -> b
    `deepseq` HUnitFailure -> Assertion
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (Maybe SrcLoc -> FailureReason -> HUnitFailure
    HUnitFailure Maybe SrcLoc
    HasCallStack => Maybe SrcLoc
    location (FailureReason -> HUnitFailure) -> FailureReason -> HUnitFailure
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> String -> String -> FailureReason
    ExpectedButGot Maybe String
    prefaceMsg String
    expectedMsg String
    actualMsg))
      where
        prefaceMsg :: Maybe String
    prefaceMsg
          | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    preface = Maybe String
    forall a. Maybe a
    Nothing
          | Bool
    otherwise = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    preface
        expectedMsg :: String
    expectedMsg = a -> String
    forall a. Show a => a -> String
    show a
    expected
        actualMsg :: String
    actualMsg = a -> String
    forall a. Show a => a -> String
    show a
    actual

    formatFailureReason :: FailureReason -> String
    formatFailureReason :: FailureReason -> String
    formatFailureReason (Reason String
    reason) = String
    reason
    formatFailureReason (ExpectedButGot Maybe String
    preface String
    expected String
    actual) = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String] -> [String])
    -> (String -> [String] -> [String])
    -> Maybe String
    -> [String]
    -> [String]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [String] -> [String]
    forall a. a -> a
    id (:) Maybe String
    preface ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String
    "expected: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    expected, String
    " but got: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    actual]

    data Result = Success | Failure (Maybe SrcLoc) String | Error (Maybe SrcLoc) String
      deriving (Result -> Result -> Bool
    (Result -> Result -> Bool)
    -> (Result -> Result -> Bool) -> Eq Result
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Result -> Result -> Bool
    == :: Result -> Result -> Bool
    $c/= :: Result -> Result -> Bool
    /= :: Result -> Result -> Bool
    Eq, Int -> Result -> ShowS
    [Result] -> ShowS
    Result -> String
    (Int -> Result -> ShowS)
    -> (Result -> String) -> ([Result] -> ShowS) -> Show Result
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Result -> ShowS
    showsPrec :: Int -> Result -> ShowS
    $cshow :: Result -> String
    show :: Result -> String
    $cshowList :: [Result] -> ShowS
    showList :: [Result] -> ShowS
    Show)

    -- | Performs a single test case.
    performTestCase :: Assertion -- ^ an assertion to be made during the test case run
                    -> IO Result
    performTestCase :: Assertion -> IO Result
    performTestCase Assertion
    action =
      (Assertion
    action Assertion -> IO Result -> IO Result
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    Success)
         IO Result -> [Handler Result] -> IO Result
    forall a. IO a -> [Handler a] -> IO a
    `E.catches`
          [(HUnitFailure -> IO Result) -> Handler Result
    forall a e. Exception e => (e -> IO a) -> Handler a
    E.Handler (\(HUnitFailure Maybe SrcLoc
    loc FailureReason
    reason) -> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ Maybe SrcLoc -> String -> Result
    Failure Maybe SrcLoc
    loc (FailureReason -> String
    formatFailureReason FailureReason
    reason)),

           -- Re-throw AsyncException, otherwise execution will not terminate on
           -- SIGINT (ctrl-c).  Currently, all AsyncExceptions are being thrown
           -- because it's thought that none of them will be encountered during
           -- normal HUnit operation.  If you encounter an example where this
           -- is not the case, please email the maintainer.
           (AsyncException -> IO Result) -> Handler Result
    forall a e. Exception e => (e -> IO a) -> Handler a
    E.Handler (\AsyncException
    e -> AsyncException -> IO Result
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (AsyncException
    e :: E.AsyncException)),

           (SomeException -> IO Result) -> Handler Result
    forall a e. Exception e => (e -> IO a) -> Handler a
    E.Handler (\SomeException
    e -> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ Maybe SrcLoc -> String -> Result
    Error Maybe SrcLoc
    forall a. Maybe a
    Nothing (String -> Result) -> String -> Result
    forall a b. (a -> b) -> a -> b
    $ SomeException -> String
    forall a. Show a => a -> String
    show (SomeException
    e :: E.SomeException))]