module Test.TLT.Assertion where
import Control.Monad.Trans.State.Strict
import Test.TLT.Results
import Test.TLT.Buffer
import Test.TLT.Class
type Assertion m = m [TestFail]
assertFailed :: Monad m => String -> Assertion m
assertFailed :: forall (m :: * -> *). Monad m => String -> Assertion m
assertFailed String
msg = forall (m :: * -> *) a. Monad m => a -> m a
return [String -> TestFail
Asserted String
msg]
assertSuccess :: Monad m => Assertion m
assertSuccess :: forall (m :: * -> *). Monad m => Assertion m
assertSuccess = forall (m :: * -> *) a. Monad m => a -> m a
return []
infix 0 ~:, ~::, ~::-
(~:) :: MonadTLT m n => String -> Assertion m -> m ()
String
s ~: :: forall (m :: * -> *) (n :: * -> *).
MonadTLT m n =>
String -> Assertion m -> m ()
~: Assertion m
a = do
(TLTopts
opts, TRBuf
oldState) <- forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. StateT (TLTopts, TRBuf) m r -> TLT m r
TLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => StateT s m s
get
[TestFail]
assessment <- Assertion m
a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. StateT (TLTopts, TRBuf) m r -> TLT m r
TLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTopts
opts, TRBuf -> TestResult -> TRBuf
addResult TRBuf
oldState forall a b. (a -> b) -> a -> b
$ String -> [TestFail] -> TestResult
Test String
s [TestFail]
assessment)
(~::-) :: MonadTLT m n => String -> Bool -> m ()
String
s ~::- :: forall (m :: * -> *) (n :: * -> *).
MonadTLT m n =>
String -> Bool -> m ()
~::- Bool
b = do
(TLTopts
opts, TRBuf
oldState) <- forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. StateT (TLTopts, TRBuf) m r -> TLT m r
TLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => StateT s m s
get
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. StateT (TLTopts, TRBuf) m r -> TLT m r
TLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTopts
opts, TRBuf -> TestResult -> TRBuf
addResult TRBuf
oldState forall a b. (a -> b) -> a -> b
$ String -> [TestFail] -> TestResult
Test String
s forall a b. (a -> b) -> a -> b
$
if Bool
b then [] else [String -> TestFail
Asserted forall a b. (a -> b) -> a -> b
$ String
"Expected True but got False"])
(~::) :: MonadTLT m n => String -> m Bool -> m ()
String
s ~:: :: forall (m :: * -> *) (n :: * -> *).
MonadTLT m n =>
String -> m Bool -> m ()
~:: m Bool
bM = do
Bool
b <- m Bool
bM
(TLTopts
opts, TRBuf
oldState) <- forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. StateT (TLTopts, TRBuf) m r -> TLT m r
TLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => StateT s m s
get
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. StateT (TLTopts, TRBuf) m r -> TLT m r
TLT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTopts
opts, TRBuf -> TestResult -> TRBuf
addResult TRBuf
oldState forall a b. (a -> b) -> a -> b
$ String -> [TestFail] -> TestResult
Test String
s forall a b. (a -> b) -> a -> b
$
if Bool
b then [] else [String -> TestFail
Asserted forall a b. (a -> b) -> a -> b
$ String
"Expected True but got False"])
liftAssertion2Pure ::
(Monad m) => (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
tester a -> a -> String
explainer a
exp a
actual = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if (a -> a -> Bool
tester a
exp a
actual) then [] else [String -> TestFail
Asserted forall a b. (a -> b) -> a -> b
$ a -> a -> String
explainer a
exp a
actual]
assertion2PtoM ::
(Monad m) => (a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM a -> a -> Assertion m
pa a
exp m a
actualM = do a
actual <- m a
actualM
a -> a -> Assertion m
pa a
exp a
actual
liftAssertion2M ::
(Monad m) => (a -> a -> Bool) -> (a -> a -> String) -> a -> m a -> Assertion m
liftAssertion2M :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> m a -> Assertion m
liftAssertion2M a -> a -> Bool
tester a -> a -> String
explainer a
exp m a
actualM =
let assertPure :: a -> Assertion m
assertPure = forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
tester a -> a -> String
explainer a
exp
in do a
actual <- m a
actualM
a -> Assertion m
assertPure a
actual
liftAssertionPure ::
(Monad m) => (a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure a -> Bool
tester a -> String
explainer a
actual = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if (a -> Bool
tester a
actual) then [] else [String -> TestFail
Asserted forall a b. (a -> b) -> a -> b
$ a -> String
explainer a
actual]
assertionPtoM :: (Monad m) => (a -> Assertion m) -> m a -> Assertion m
assertionPtoM :: forall (m :: * -> *) a.
Monad m =>
(a -> Assertion m) -> m a -> Assertion m
assertionPtoM a -> Assertion m
pa m a
actualM = do a
actual <- m a
actualM
a -> Assertion m
pa a
actual
liftAssertionM ::
(Monad m) => (a -> Bool) -> (a -> String) -> m a -> Assertion m
liftAssertionM :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> String) -> m a -> Assertion m
liftAssertionM a -> Bool
tester a -> String
explainer m a
actualM =
let assertPure :: a -> Assertion m
assertPure = forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure a -> Bool
tester a -> String
explainer
in do a
actual <- m a
actualM
a -> Assertion m
assertPure a
actual