{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}

module Test.Fluent.Internal.Assertions where

import Control.Exception (Exception, throwIO, try)
import Data.Either (isLeft, lefts, rights)
import Data.Functor.Contravariant (Contravariant (contramap))
import GHC.Exception (SrcLoc, getCallStack)
import GHC.Stack (HasCallStack, callStack)
import System.Timeout (timeout)
import Test.Fluent.Internal.AssertionConfig
  ( AssertionConfig (assertionTimeout),
    defaultConfig,
  )

data FluentTestFailure = FluentTestFailure
  { FluentTestFailure -> Maybe SrcLoc
srcLoc :: !(Maybe SrcLoc),
    FluentTestFailure -> [(String, Maybe SrcLoc)]
msg :: ![(String, Maybe SrcLoc)],
    FluentTestFailure -> Int
errorsCount :: !Int,
    FluentTestFailure -> Int
successCount :: !Int
  }
  deriving (Int -> FluentTestFailure -> ShowS
[FluentTestFailure] -> ShowS
FluentTestFailure -> String
(Int -> FluentTestFailure -> ShowS)
-> (FluentTestFailure -> String)
-> ([FluentTestFailure] -> ShowS)
-> Show FluentTestFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FluentTestFailure] -> ShowS
$cshowList :: [FluentTestFailure] -> ShowS
show :: FluentTestFailure -> String
$cshow :: FluentTestFailure -> String
showsPrec :: Int -> FluentTestFailure -> ShowS
$cshowsPrec :: Int -> FluentTestFailure -> ShowS
Show)

instance Exception FluentTestFailure

data AssertionFailure = AssertionFailure
  { AssertionFailure -> String
message :: !String,
    AssertionFailure -> Maybe SrcLoc
assertionSrcLoc :: !(Maybe SrcLoc)
  }
  deriving (Int -> AssertionFailure -> ShowS
[AssertionFailure] -> ShowS
AssertionFailure -> String
(Int -> AssertionFailure -> ShowS)
-> (AssertionFailure -> String)
-> ([AssertionFailure] -> ShowS)
-> Show AssertionFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionFailure] -> ShowS
$cshowList :: [AssertionFailure] -> ShowS
show :: AssertionFailure -> String
$cshow :: AssertionFailure -> String
showsPrec :: Int -> AssertionFailure -> ShowS
$cshowsPrec :: Int -> AssertionFailure -> ShowS
Show)

instance Exception AssertionFailure

data AssertionDefinition a
  = ParallelAssertions [AssertionDefinition a]
  | SequentialAssertions [AssertionDefinition a]
  | SimpleAssertion
      { AssertionDefinition a -> Maybe String -> a -> IO ()
assertion :: Maybe String -> a -> IO (),
        AssertionDefinition a -> Maybe String
label :: Maybe String
      }

instance Show (AssertionDefinition a) where
  show :: AssertionDefinition a -> String
show (ParallelAssertions [AssertionDefinition a]
a) = String
"ParallelAssertions " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [AssertionDefinition a] -> String
forall a. Show a => a -> String
show [AssertionDefinition a]
a
  show (SequentialAssertions [AssertionDefinition a]
a) = String
"SequentialAssertions " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [AssertionDefinition a] -> String
forall a. Show a => a -> String
show [AssertionDefinition a]
a
  show (SimpleAssertion Maybe String -> a -> IO ()
_ Maybe String
assertionLabel) = String
"SimpleAssertion - " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe String -> String
forall a. Show a => a -> String
show Maybe String
assertionLabel

instance Contravariant AssertionDefinition where
  contramap :: (a -> b) -> AssertionDefinition b -> AssertionDefinition a
contramap a -> b
f (ParallelAssertions [AssertionDefinition b]
assertions) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions ((AssertionDefinition b -> AssertionDefinition a)
-> [AssertionDefinition b] -> [AssertionDefinition a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> AssertionDefinition b -> AssertionDefinition a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f) [AssertionDefinition b]
assertions)
  contramap a -> b
f (SequentialAssertions [AssertionDefinition b]
assertions) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions ((AssertionDefinition b -> AssertionDefinition a)
-> [AssertionDefinition b] -> [AssertionDefinition a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> AssertionDefinition b -> AssertionDefinition a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f) [AssertionDefinition b]
assertions)
  contramap a -> b
f (SimpleAssertion Maybe String -> b -> IO ()
assert Maybe String
assertionLabel) = (Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
forall a.
(Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
SimpleAssertion (\Maybe String
l -> Maybe String -> b -> IO ()
assert Maybe String
l (b -> IO ()) -> (a -> b) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Maybe String
assertionLabel

instance Semigroup (AssertionDefinition a) where -- TODO: looks like this instance is not lawful, should be removed and replaced by plain function
  ParallelAssertions [AssertionDefinition a]
a <> :: AssertionDefinition a
-> AssertionDefinition a -> AssertionDefinition a
<> ParallelAssertions [AssertionDefinition a]
b = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions ([AssertionDefinition a]
b [AssertionDefinition a]
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. Semigroup a => a -> a -> a
<> [AssertionDefinition a]
a)
  ParallelAssertions [AssertionDefinition a]
a <> b :: AssertionDefinition a
b@(SequentialAssertions [AssertionDefinition a]
_) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions (AssertionDefinition a
b AssertionDefinition a
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. a -> [a] -> [a]
: [AssertionDefinition a]
a)
  SequentialAssertions [AssertionDefinition a]
a <> b :: AssertionDefinition a
b@(ParallelAssertions [AssertionDefinition a]
_) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions (AssertionDefinition a
b AssertionDefinition a
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. a -> [a] -> [a]
: [AssertionDefinition a]
a)
  SequentialAssertions [AssertionDefinition a]
a <> SequentialAssertions [AssertionDefinition a]
b = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions ([AssertionDefinition a]
b [AssertionDefinition a]
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. Semigroup a => a -> a -> a
<> [AssertionDefinition a]
a)
  s :: AssertionDefinition a
s@(SimpleAssertion Maybe String -> a -> IO ()
_ Maybe String
_) <> ParallelAssertions [AssertionDefinition a]
a = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions ([AssertionDefinition a]
a [AssertionDefinition a]
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. [a] -> [a] -> [a]
++ [AssertionDefinition a
s])
  ParallelAssertions [AssertionDefinition a]
a <> s :: AssertionDefinition a
s@(SimpleAssertion Maybe String -> a -> IO ()
_ Maybe String
_) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions (AssertionDefinition a
s AssertionDefinition a
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. a -> [a] -> [a]
: [AssertionDefinition a]
a)
  s :: AssertionDefinition a
s@(SimpleAssertion Maybe String -> a -> IO ()
_ Maybe String
_) <> SequentialAssertions [AssertionDefinition a]
a = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions ([AssertionDefinition a]
a [AssertionDefinition a]
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. [a] -> [a] -> [a]
++ [AssertionDefinition a
s])
  SequentialAssertions [AssertionDefinition a]
a <> s :: AssertionDefinition a
s@(SimpleAssertion Maybe String -> a -> IO ()
_ Maybe String
_) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions (AssertionDefinition a
s AssertionDefinition a
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. a -> [a] -> [a]
: [AssertionDefinition a]
a)
  a :: AssertionDefinition a
a@(SimpleAssertion Maybe String -> a -> IO ()
_ Maybe String
_) <> b :: AssertionDefinition a
b@(SimpleAssertion Maybe String -> a -> IO ()
_ Maybe String
_) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions [AssertionDefinition a
b, AssertionDefinition a
a]

instance Monoid (AssertionDefinition a) where
  mempty :: AssertionDefinition a
mempty = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions []

updateLabel :: String -> AssertionDefinition a -> AssertionDefinition a
updateLabel :: String -> AssertionDefinition a -> AssertionDefinition a
updateLabel String
newLabel (SimpleAssertion Maybe String -> a -> IO ()
assert (Just String
oldLabel)) = (Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
forall a.
(Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
SimpleAssertion Maybe String -> a -> IO ()
assert (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
newLabel String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
oldLabel)
updateLabel String
assertionLabel (SimpleAssertion Maybe String -> a -> IO ()
a Maybe String
Nothing) = (Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
forall a.
(Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
SimpleAssertion Maybe String -> a -> IO ()
a (String -> Maybe String
forall a. a -> Maybe a
Just String
assertionLabel)
updateLabel String
assertionLabel (ParallelAssertions (AssertionDefinition a
x : [AssertionDefinition a]
xs)) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions (String -> AssertionDefinition a -> AssertionDefinition a
forall a. String -> AssertionDefinition a -> AssertionDefinition a
updateLabel String
assertionLabel AssertionDefinition a
x AssertionDefinition a
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. a -> [a] -> [a]
: (AssertionDefinition a -> AssertionDefinition a)
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> AssertionDefinition a -> AssertionDefinition a
forall a. String -> AssertionDefinition a -> AssertionDefinition a
updateLabel String
assertionLabel) [AssertionDefinition a]
xs)
updateLabel String
assertionLabel (SequentialAssertions (AssertionDefinition a
x : [AssertionDefinition a]
xs)) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions (String -> AssertionDefinition a -> AssertionDefinition a
forall a. String -> AssertionDefinition a -> AssertionDefinition a
updateLabel String
assertionLabel AssertionDefinition a
x AssertionDefinition a
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall a. a -> [a] -> [a]
: (AssertionDefinition a -> AssertionDefinition a)
-> [AssertionDefinition a] -> [AssertionDefinition a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> AssertionDefinition a -> AssertionDefinition a
forall a. String -> AssertionDefinition a -> AssertionDefinition a
updateLabel String
assertionLabel) [AssertionDefinition a]
xs)
updateLabel String
_ (ParallelAssertions []) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions []
updateLabel String
_ (SequentialAssertions []) = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions []

-- | Execute assertions against given subject under test.
assertThat :: HasCallStack => a -> Assertion' a b -> IO ()
assertThat :: a -> Assertion' a b -> IO ()
assertThat a
given = IO a -> Assertion' a b -> IO ()
forall a b. HasCallStack => IO a -> Assertion' a b -> IO ()
assertThatIO (a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
given)

-- | Execute assertions against given subject under test extracted from IO action.
assertThatIO :: HasCallStack => IO a -> Assertion' a b -> IO ()
assertThatIO :: IO a -> Assertion' a b -> IO ()
assertThatIO IO a
given = AssertionConfig
-> IO a -> (IO a -> IO a) -> Assertion' a b -> IO ()
forall a b c.
HasCallStack =>
AssertionConfig
-> IO a -> (IO a -> IO b) -> Assertion' b c -> IO ()
assertThatIO'' AssertionConfig
defaultConfig IO a
given IO a -> IO a
forall a. a -> a
id

-- | A variant of `assertThat` which allow to pass additional configuration.
assertThat' :: HasCallStack => AssertionConfig -> a -> Assertion' a b -> IO ()
assertThat' :: AssertionConfig -> a -> Assertion' a b -> IO ()
assertThat' AssertionConfig
config a
given = AssertionConfig -> IO a -> Assertion' a b -> IO ()
forall a c.
HasCallStack =>
AssertionConfig -> IO a -> Assertion' a c -> IO ()
assertThatIO' AssertionConfig
config (a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
given)

-- | A variant of `assertThatIO` which allow to pass additional configuration.
assertThatIO' :: HasCallStack => AssertionConfig -> IO a -> Assertion' a c -> IO ()
assertThatIO' :: AssertionConfig -> IO a -> Assertion' a c -> IO ()
assertThatIO' AssertionConfig
config IO a
givenIO = AssertionConfig
-> IO a -> (IO a -> IO a) -> Assertion' a c -> IO ()
forall a b c.
HasCallStack =>
AssertionConfig
-> IO a -> (IO a -> IO b) -> Assertion' b c -> IO ()
assertThatIO'' AssertionConfig
config IO a
givenIO IO a -> IO a
forall a. a -> a
id

assertThatIO'' :: HasCallStack => AssertionConfig -> IO a -> (IO a -> IO b) -> Assertion' b c -> IO ()
assertThatIO'' :: AssertionConfig
-> IO a -> (IO a -> IO b) -> Assertion' b c -> IO ()
assertThatIO'' AssertionConfig
config IO a
givenIO IO a -> IO b
f Assertion' b c
b = do
  b
given <- IO a -> IO b
f IO a
givenIO
  case Assertion' b c
b (AssertionDefinition c -> c -> AssertionDefinition c
forall a b. a -> b -> a
const AssertionDefinition c
forall a. Monoid a => a
mempty) b
given of
    SimpleAssertion Maybe String -> b -> IO ()
assert Maybe String
assertionLabel -> do
      Either AssertionFailure ()
assertionResult <- IO () -> IO (Either AssertionFailure ())
forall e a. Exception e => IO a -> IO (Either e a)
try (Maybe String -> b -> IO ()
assert Maybe String
assertionLabel b
given)
      case Either AssertionFailure ()
assertionResult of
        Right () -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Left (AssertionFailure String
failureMessage Maybe SrcLoc
assertionLocation) -> FluentTestFailure -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Maybe SrcLoc
-> [(String, Maybe SrcLoc)] -> Int -> Int -> FluentTestFailure
FluentTestFailure Maybe SrcLoc
location [(String
failureMessage, Maybe SrcLoc
assertionLocation)] Int
1 Int
0)
    AssertionDefinition b
assertions -> do
      [Either AssertionFailure ()]
assertionResults <- AssertionConfig
-> b -> AssertionDefinition b -> IO [Either AssertionFailure ()]
forall a.
HasCallStack =>
AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
flattenAssertions AssertionConfig
config b
given AssertionDefinition b
assertions
      let errors :: [(String, Maybe SrcLoc)]
errors = (\AssertionFailure
assertionError -> (AssertionFailure -> String
message AssertionFailure
assertionError, AssertionFailure -> Maybe SrcLoc
assertionSrcLoc AssertionFailure
assertionError)) (AssertionFailure -> (String, Maybe SrcLoc))
-> [AssertionFailure] -> [(String, Maybe SrcLoc)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either AssertionFailure ()] -> [AssertionFailure]
forall a b. [Either a b] -> [a]
lefts [Either AssertionFailure ()]
assertionResults
      let successes :: Int
successes = [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([()] -> Int) -> [()] -> Int
forall a b. (a -> b) -> a -> b
$ [Either AssertionFailure ()] -> [()]
forall a b. [Either a b] -> [b]
rights [Either AssertionFailure ()]
assertionResults
      if [(String, Maybe SrcLoc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Maybe SrcLoc)]
errors then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else FluentTestFailure -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Maybe SrcLoc
-> [(String, Maybe SrcLoc)] -> Int -> Int -> FluentTestFailure
FluentTestFailure Maybe SrcLoc
location [(String, Maybe SrcLoc)]
errors ([(String, Maybe SrcLoc)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Maybe SrcLoc)]
errors) Int
successes)
  where
    location :: Maybe SrcLoc
location = case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
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

flattenAssertions :: HasCallStack => AssertionConfig -> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
flattenAssertions :: AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
flattenAssertions AssertionConfig
config a
a (SimpleAssertion Maybe String -> a -> IO ()
assert Maybe String
assertionLabel) = [IO (Either AssertionFailure ())]
-> IO [Either AssertionFailure ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [AssertionConfig
-> (Maybe String -> a -> IO ())
-> Maybe String
-> a
-> IO (Either AssertionFailure ())
forall t2.
HasCallStack =>
AssertionConfig
-> (Maybe String -> t2 -> IO ())
-> Maybe String
-> t2
-> IO (Either AssertionFailure ())
executeAssertion AssertionConfig
config Maybe String -> a -> IO ()
assert Maybe String
assertionLabel a
a]
flattenAssertions AssertionConfig
config a
a (ParallelAssertions [AssertionDefinition a]
assertions) = [[Either AssertionFailure ()]] -> [Either AssertionFailure ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either AssertionFailure ()]] -> [Either AssertionFailure ()])
-> IO [[Either AssertionFailure ()]]
-> IO [Either AssertionFailure ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AssertionDefinition a -> IO [Either AssertionFailure ()])
-> [AssertionDefinition a] -> IO [[Either AssertionFailure ()]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
forall a.
HasCallStack =>
AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
flattenAssertions AssertionConfig
config a
a) [AssertionDefinition a]
assertions
flattenAssertions AssertionConfig
_ a
_ (SequentialAssertions []) = [Either AssertionFailure ()] -> IO [Either AssertionFailure ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
flattenAssertions AssertionConfig
config a
a (SequentialAssertions (AssertionDefinition a
x : [AssertionDefinition a]
xs)) = do
  [Either AssertionFailure ()]
results <- AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
forall a.
HasCallStack =>
AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
flattenAssertions AssertionConfig
config a
a AssertionDefinition a
x
  let isFailed :: Bool
isFailed = (Either AssertionFailure () -> Bool)
-> [Either AssertionFailure ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Either AssertionFailure () -> Bool
forall a b. Either a b -> Bool
isLeft [Either AssertionFailure ()]
results
  if Bool
isFailed
    then [Either AssertionFailure ()] -> IO [Either AssertionFailure ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Either AssertionFailure ()]
results
    else AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
forall a.
HasCallStack =>
AssertionConfig
-> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]
flattenAssertions AssertionConfig
config a
a ([AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions [AssertionDefinition a]
xs)

executeAssertion :: HasCallStack => AssertionConfig -> (Maybe String -> t2 -> IO ()) -> Maybe String -> t2 -> IO (Either AssertionFailure ())
executeAssertion :: AssertionConfig
-> (Maybe String -> t2 -> IO ())
-> Maybe String
-> t2
-> IO (Either AssertionFailure ())
executeAssertion AssertionConfig
config Maybe String -> t2 -> IO ()
assert Maybe String
assertionLabel t2
given = do
  Maybe (Either AssertionFailure ())
result <- IO (Either AssertionFailure ())
-> IO (Maybe (Either AssertionFailure ()))
forall a. IO a -> IO (Maybe a)
withTimeout (IO (Either AssertionFailure ())
 -> IO (Maybe (Either AssertionFailure ())))
-> IO (Either AssertionFailure ())
-> IO (Maybe (Either AssertionFailure ()))
forall a b. (a -> b) -> a -> b
$ do
    !Either AssertionFailure ()
assertionResult <- IO () -> IO (Either AssertionFailure ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either AssertionFailure ()))
-> IO () -> IO (Either AssertionFailure ())
forall a b. (a -> b) -> a -> b
$ Maybe String -> t2 -> IO ()
assert Maybe String
assertionLabel t2
given
    Either AssertionFailure () -> IO (Either AssertionFailure ())
forall (m :: * -> *) a. Monad m => a -> m a
return Either AssertionFailure ()
assertionResult
  case Maybe (Either AssertionFailure ())
result of
    Maybe (Either AssertionFailure ())
Nothing ->
      Either AssertionFailure () -> IO (Either AssertionFailure ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssertionFailure -> Either AssertionFailure ()
forall a b. a -> Either a b
Left (AssertionFailure -> Either AssertionFailure ())
-> AssertionFailure -> Either AssertionFailure ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe SrcLoc -> AssertionFailure
AssertionFailure (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
x -> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] ") Maybe String
assertionLabel String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
timeoutMessage) Maybe SrcLoc
location)
    Just Either AssertionFailure ()
a -> Either AssertionFailure () -> IO (Either AssertionFailure ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either AssertionFailure ()
a
  where
    withTimeout :: IO a -> IO (Maybe a)
withTimeout = Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int -> IO a -> IO (Maybe a)) -> Int -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ AssertionConfig -> Int
assertionTimeout AssertionConfig
config
    timeoutMessage :: String
timeoutMessage = String
"Timeout occurred, probably some infinitive data structure or not terminating predicate has been used. Timeout: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
timeoutInSeconds String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"s"
    timeoutInSeconds :: Double
    timeoutInSeconds :: Double
timeoutInSeconds = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AssertionConfig -> Int
assertionTimeout AssertionConfig
config) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000000.0
    location :: Maybe SrcLoc
    location :: Maybe SrcLoc
location = case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
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

transformAssertions :: [AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions :: [AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions ((SimpleAssertion Maybe String -> a -> IO ()
assert Maybe String
assertionLabel) : [AssertionDefinition a]
xs) b -> a
f = (Maybe String -> b -> IO ())
-> Maybe String -> AssertionDefinition b
forall a.
(Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
SimpleAssertion (\Maybe String
l b
b -> Maybe String -> a -> IO ()
assert (Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
orElse Maybe String
l Maybe String
assertionLabel) (b -> a
f b
b)) Maybe String
assertionLabel AssertionDefinition b
-> [AssertionDefinition b] -> [AssertionDefinition b]
forall a. a -> [a] -> [a]
: [AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
forall a b.
[AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions [AssertionDefinition a]
xs b -> a
f
transformAssertions ((ParallelAssertions [AssertionDefinition a]
assertions) : [AssertionDefinition a]
xs) b -> a
f = [AssertionDefinition b] -> AssertionDefinition b
forall a. [AssertionDefinition a] -> AssertionDefinition a
ParallelAssertions ([AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
forall a b.
[AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions [AssertionDefinition a]
assertions b -> a
f) AssertionDefinition b
-> [AssertionDefinition b] -> [AssertionDefinition b]
forall a. a -> [a] -> [a]
: [AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
forall a b.
[AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions [AssertionDefinition a]
xs b -> a
f
transformAssertions ((SequentialAssertions [AssertionDefinition a]
assertions) : [AssertionDefinition a]
xs) b -> a
f = [AssertionDefinition b] -> AssertionDefinition b
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions ([AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
forall a b.
[AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions [AssertionDefinition a]
assertions b -> a
f) AssertionDefinition b
-> [AssertionDefinition b] -> [AssertionDefinition b]
forall a. a -> [a] -> [a]
: [AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
forall a b.
[AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions [AssertionDefinition a]
xs b -> a
f
transformAssertions [] b -> a
_ = []

orElse :: Maybe a -> Maybe a -> Maybe a
Maybe a
x orElse :: Maybe a -> Maybe a -> Maybe a
`orElse` Maybe a
y = case Maybe a
x of
  Just a
_ -> Maybe a
x
  Maybe a
Nothing -> Maybe a
y

basicAssertion :: HasCallStack => (a -> Bool) -> (a -> String) -> AssertionDefinition a -> AssertionDefinition a
basicAssertion :: (a -> Bool)
-> (a -> String) -> AssertionDefinition a -> AssertionDefinition a
basicAssertion a -> Bool
predicate a -> String
messageFormatter AssertionDefinition a
b = AssertionDefinition a
b AssertionDefinition a
-> AssertionDefinition a -> AssertionDefinition a
forall a. Semigroup a => a -> a -> a
<> (Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
forall a.
(Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
SimpleAssertion Maybe String -> a -> IO ()
assert Maybe String
forall a. Maybe a
Nothing
  where
    assert :: Maybe String -> a -> IO ()
assert Maybe String
assertionLabel a
a' =
      if a -> Bool
predicate a
a'
        then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else AssertionFailure -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> Maybe SrcLoc -> AssertionFailure
AssertionFailure (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
x -> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] ") Maybe String
assertionLabel String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
messageFormatter a
a') Maybe SrcLoc
location)
    location :: Maybe SrcLoc
    location :: Maybe SrcLoc
location = case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
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

basicIOAssertion :: HasCallStack => (a -> Bool) -> (a -> String) -> AssertionDefinition (IO a) -> AssertionDefinition (IO a)
basicIOAssertion :: (a -> Bool)
-> (a -> String)
-> AssertionDefinition (IO a)
-> AssertionDefinition (IO a)
basicIOAssertion a -> Bool
predicate a -> String
messageFormatter AssertionDefinition (IO a)
b = AssertionDefinition (IO a)
b AssertionDefinition (IO a)
-> AssertionDefinition (IO a) -> AssertionDefinition (IO a)
forall a. Semigroup a => a -> a -> a
<> (Maybe String -> IO a -> IO ())
-> Maybe String -> AssertionDefinition (IO a)
forall a.
(Maybe String -> a -> IO ())
-> Maybe String -> AssertionDefinition a
SimpleAssertion Maybe String -> IO a -> IO ()
assert Maybe String
forall a. Maybe a
Nothing
  where
    assert :: Maybe String -> IO a -> IO ()
assert Maybe String
assertionLabel IO a
a' = do
      a
aaa <- IO a
a'
      if a -> Bool
predicate a
aaa
        then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else AssertionFailure -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> Maybe SrcLoc -> AssertionFailure
AssertionFailure (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
x -> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] ") Maybe String
assertionLabel String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
messageFormatter a
aaa) Maybe SrcLoc
location)
    location :: Maybe SrcLoc
    location :: Maybe SrcLoc
location = case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
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

type Assertion'' s t a b = (a -> AssertionDefinition b) -> s -> AssertionDefinition t

type Assertion' a b = Assertion'' a a b b

type Assertion a = Assertion' a a