{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Test.TLT (
TLT, tlt, MonadTLT, liftTLT, tltCore,
reportAllTestResults, setExitAfterFailDisplay,
Assertion,
(~:), (~::), (~::-), tltFail, inGroup,
(@==), (@/=), (@<), (@>), (@<=), (@>=),
(@==-), (@/=-), (@<-), (@>-), (@<=-), (@>=-),
empty, nonempty, emptyP, nonemptyP,
nothing, nothingP, assertFailed, assertSuccess,
liftAssertionPure, assertionPtoM, liftAssertionM,
liftAssertion2Pure, assertion2PtoM, liftAssertion2M
) where
import Data.Maybe
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.ST.Trans
import Control.Monad.Trans.Class
import Control.Monad.Trans.Free
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Resource
import Control.Monad.Trans.State.Strict
import qualified Control.Monad.Trans.State.Lazy as SL
import qualified Control.Monad.Trans.Writer.Lazy as WL
import qualified Control.Monad.Trans.Writer.Strict as WS
import System.Console.ANSI
import System.Exit
data TestFail = Asserted String
| Erred String
formatFail :: TestFail -> String
formatFail :: TestFail -> String
formatFail (Asserted String
s) = String
s
formatFail (Erred String
s) = String
"Assertion raised exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
type Assertion m = m [TestFail]
data TestResult = Test String [TestFail]
| Group String Int Int [TestResult]
failCount :: TestResult -> Int
failCount :: TestResult -> Int
failCount (Test String
_ []) = Int
0
failCount (Test String
_ [TestFail]
_) = Int
1
failCount (Group String
_ Int
_ Int
n [TestResult]
_) = Int
n
testCount :: TestResult -> Int
testCount :: TestResult -> Int
testCount (Test String
_ [TestFail]
_) = Int
1
testCount (Group String
_ Int
n Int
_ [TestResult]
_) = Int
n
totalFailCount :: [TestResult] -> Int
totalFailCount :: [TestResult] -> Int
totalFailCount = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> Int) -> ([TestResult] -> [Int]) -> [TestResult] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestResult -> Int) -> [TestResult] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map TestResult -> Int
failCount
totalTestCount :: [TestResult] -> Int
totalTestCount :: [TestResult] -> Int
totalTestCount = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> Int) -> ([TestResult] -> [Int]) -> [TestResult] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestResult -> Int) -> [TestResult] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map TestResult -> Int
testCount
report :: TLTopts -> [TestResult] -> IO ()
report :: TLTopts -> [TestResult] -> IO ()
report (TLTopts Bool
showPasses Bool
exitAfterFailDisplay) [TestResult]
trs =
let fails :: Int
fails = [TestResult] -> Int
totalFailCount [TestResult]
trs
tests :: Int
tests = [TestResult] -> Int
totalTestCount [TestResult]
trs
in do String -> [TestResult] -> IO ()
report' String
"" [TestResult]
trs
if Int
fails Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then do IO ()
boldRed
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
fails String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" error"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Int
fails Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then String
"s" else String
"")
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tests String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests; exiting"
IO ()
mediumBlack
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exitAfterFailDisplay IO ()
forall a. IO a
exitFailure
else do IO ()
boldGreen
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
tests String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" test"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Int
tests Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then String
"s" else String
"")
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" passing."
IO ()
mediumBlack
where report' :: String -> [TestResult] -> IO ()
report' String
ind [TestResult]
trs = [TestResult] -> (TestResult -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TestResult]
trs ((TestResult -> IO ()) -> IO ()) -> (TestResult -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ TestResult
tr ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TestResult -> Int
failCount TestResult
tr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Bool
showPasses) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
case TestResult
tr of
Test String
s [TestFail]
r -> do
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
ind String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
case [TestFail]
r of
[] -> do
IO ()
greenPass
String -> IO ()
putStrLn String
""
TestFail
x : [] -> do
IO ()
redFail
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TestFail -> String
formatFail TestFail
x
[TestFail]
_ -> do
IO ()
redFail
String -> IO ()
putStrLn String
":"
[TestFail] -> (TestFail -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TestFail]
r ((TestFail -> IO ()) -> IO ()) -> (TestFail -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ TestFail
f -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
ind String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TestFail -> String
formatFail TestFail
f
Group String
s Int
_ Int
_ [TestResult]
trs' -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
ind String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
String -> [TestResult] -> IO ()
report' (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ind) [TestResult]
trs'
boldBlack :: IO ()
boldBlack = [SGR] -> IO ()
setSGR [
ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Black, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity ]
boldRed :: IO ()
boldRed = [SGR] -> IO ()
setSGR [
ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity ]
boldGreen :: IO ()
boldGreen = [SGR] -> IO ()
setSGR [
ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Green, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity ]
mediumRed :: IO ()
mediumRed = [SGR] -> IO ()
setSGR [
ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
NormalIntensity ]
mediumGreen :: IO ()
mediumGreen = [SGR] -> IO ()
setSGR [
ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Green, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
NormalIntensity ]
mediumBlue :: IO ()
mediumBlue = [SGR] -> IO ()
setSGR [
ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Blue, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
NormalIntensity ]
mediumBlack :: IO ()
mediumBlack = [SGR] -> IO ()
setSGR [
ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Black, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
NormalIntensity ]
greenPass :: IO ()
greenPass = do
IO ()
mediumBlue
String -> IO ()
putStr String
"Pass"
IO ()
mediumBlack
redFail :: IO ()
redFail = do
IO ()
boldRed
String -> IO ()
putStr String
"FAIL"
IO ()
mediumBlack
data TRBuf = Buf TRBuf Int Int String [TestResult] | Top Int Int [TestResult]
addResult :: TRBuf -> TestResult -> TRBuf
addResult :: TRBuf -> TestResult -> TRBuf
addResult (Top Int
tc Int
fc [TestResult]
trs) TestResult
tr =
Int -> Int -> [TestResult] -> TRBuf
Top (Int
tc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TestResult -> Int
testCount TestResult
tr) (Int
fc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TestResult -> Int
failCount TestResult
tr) ([TestResult] -> TRBuf) -> [TestResult] -> TRBuf
forall a b. (a -> b) -> a -> b
$ TestResult
tr TestResult -> [TestResult] -> [TestResult]
forall a. a -> [a] -> [a]
: [TestResult]
trs
addResult (Buf TRBuf
up Int
tc Int
fc String
s [TestResult]
trs) TestResult
tr =
TRBuf -> Int -> Int -> String -> [TestResult] -> TRBuf
Buf TRBuf
up (Int
tc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TestResult -> Int
testCount TestResult
tr) (Int
fc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TestResult -> Int
failCount TestResult
tr) String
s ([TestResult] -> TRBuf) -> [TestResult] -> TRBuf
forall a b. (a -> b) -> a -> b
$ TestResult
tr TestResult -> [TestResult] -> [TestResult]
forall a. a -> [a] -> [a]
: [TestResult]
trs
currentGroup :: TRBuf -> TestResult
currentGroup :: TRBuf -> TestResult
currentGroup (Buf TRBuf
up Int
tc Int
fc String
s [TestResult]
trs) = String -> Int -> Int -> [TestResult] -> TestResult
Group String
s Int
tc Int
fc ([TestResult] -> [TestResult]
forall a. [a] -> [a]
reverse [TestResult]
trs)
popGroup :: TRBuf -> TRBuf
popGroup :: TRBuf -> TRBuf
popGroup trb :: TRBuf
trb@(Buf TRBuf
acc Int
_ Int
_ String
_ [TestResult]
_) = TRBuf -> TestResult -> TRBuf
addResult TRBuf
acc (TestResult -> TRBuf) -> TestResult -> TRBuf
forall a b. (a -> b) -> a -> b
$ TRBuf -> TestResult
currentGroup TRBuf
trb
closeTRBuf :: TRBuf -> [TestResult]
closeTRBuf :: TRBuf -> [TestResult]
closeTRBuf (Top Int
_ Int
_ [TestResult]
ts) = [TestResult] -> [TestResult]
forall a. [a] -> [a]
reverse [TestResult]
ts
closeTRBuf TRBuf
b = TRBuf -> [TestResult]
closeTRBuf (TRBuf -> [TestResult]) -> TRBuf -> [TestResult]
forall a b. (a -> b) -> a -> b
$ TRBuf -> TRBuf
popGroup TRBuf
b
data TLTopts = TLTopts {
TLTopts -> Bool
optShowPasses :: Bool,
TLTopts -> Bool
optQuitAfterFailReport :: Bool
}
defaultOpts :: TLTopts
defaultOpts = Bool -> Bool -> TLTopts
TLTopts Bool
False Bool
True
withShowPasses :: TLTopts -> Bool -> TLTopts
withShowPasses :: TLTopts -> Bool -> TLTopts
withShowPasses (TLTopts Bool
_ Bool
f) Bool
b = Bool -> Bool -> TLTopts
TLTopts Bool
b Bool
f
withExitAfterFail :: TLTopts -> Bool -> TLTopts
withExitAfterFail :: TLTopts -> Bool -> TLTopts
withExitAfterFail (TLTopts Bool
p Bool
_) Bool
b = Bool -> Bool -> TLTopts
TLTopts Bool
p Bool
b
type TLTstate = (TLTopts, TRBuf)
newtype Monad m => TLT m r = TLT { TLT m r -> StateT TLTstate m r
unwrap :: StateT TLTstate m r }
deriving (a -> TLT m b -> TLT m a
(a -> b) -> TLT m a -> TLT m b
(forall a b. (a -> b) -> TLT m a -> TLT m b)
-> (forall a b. a -> TLT m b -> TLT m a) -> Functor (TLT m)
forall a b. a -> TLT m b -> TLT m a
forall a b. (a -> b) -> TLT m a -> TLT m b
forall (m :: * -> *) a b. Functor m => a -> TLT m b -> TLT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TLT m a -> TLT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TLT m b -> TLT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> TLT m b -> TLT m a
fmap :: (a -> b) -> TLT m a -> TLT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TLT m a -> TLT m b
Functor, Functor (TLT m)
a -> TLT m a
Functor (TLT m)
-> (forall a. a -> TLT m a)
-> (forall a b. TLT m (a -> b) -> TLT m a -> TLT m b)
-> (forall a b c. (a -> b -> c) -> TLT m a -> TLT m b -> TLT m c)
-> (forall a b. TLT m a -> TLT m b -> TLT m b)
-> (forall a b. TLT m a -> TLT m b -> TLT m a)
-> Applicative (TLT m)
TLT m a -> TLT m b -> TLT m b
TLT m a -> TLT m b -> TLT m a
TLT m (a -> b) -> TLT m a -> TLT m b
(a -> b -> c) -> TLT m a -> TLT m b -> TLT m c
forall a. a -> TLT m a
forall a b. TLT m a -> TLT m b -> TLT m a
forall a b. TLT m a -> TLT m b -> TLT m b
forall a b. TLT m (a -> b) -> TLT m a -> TLT m b
forall a b c. (a -> b -> c) -> TLT m a -> TLT m b -> TLT m c
forall (m :: * -> *). Monad m => Functor (TLT m)
forall (m :: * -> *) a. Monad m => a -> TLT m a
forall (m :: * -> *) a b. Monad m => TLT m a -> TLT m b -> TLT m a
forall (m :: * -> *) a b. Monad m => TLT m a -> TLT m b -> TLT m b
forall (m :: * -> *) a b.
Monad m =>
TLT m (a -> b) -> TLT m a -> TLT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TLT m a -> TLT m b -> TLT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: TLT m a -> TLT m b -> TLT m a
$c<* :: forall (m :: * -> *) a b. Monad m => TLT m a -> TLT m b -> TLT m a
*> :: TLT m a -> TLT m b -> TLT m b
$c*> :: forall (m :: * -> *) a b. Monad m => TLT m a -> TLT m b -> TLT m b
liftA2 :: (a -> b -> c) -> TLT m a -> TLT m b -> TLT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TLT m a -> TLT m b -> TLT m c
<*> :: TLT m (a -> b) -> TLT m a -> TLT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
TLT m (a -> b) -> TLT m a -> TLT m b
pure :: a -> TLT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> TLT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (TLT m)
Applicative, Applicative (TLT m)
a -> TLT m a
Applicative (TLT m)
-> (forall a b. TLT m a -> (a -> TLT m b) -> TLT m b)
-> (forall a b. TLT m a -> TLT m b -> TLT m b)
-> (forall a. a -> TLT m a)
-> Monad (TLT m)
TLT m a -> (a -> TLT m b) -> TLT m b
TLT m a -> TLT m b -> TLT m b
forall a. a -> TLT m a
forall a b. TLT m a -> TLT m b -> TLT m b
forall a b. TLT m a -> (a -> TLT m b) -> TLT m b
forall (m :: * -> *). Monad m => Applicative (TLT m)
forall (m :: * -> *) a. Monad m => a -> TLT m a
forall (m :: * -> *) a b. Monad m => TLT m a -> TLT m b -> TLT m b
forall (m :: * -> *) a b.
Monad m =>
TLT m a -> (a -> TLT m b) -> TLT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> TLT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> TLT m a
>> :: TLT m a -> TLT m b -> TLT m b
$c>> :: forall (m :: * -> *) a b. Monad m => TLT m a -> TLT m b -> TLT m b
>>= :: TLT m a -> (a -> TLT m b) -> TLT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
TLT m a -> (a -> TLT m b) -> TLT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (TLT m)
Monad, m a -> TLT m a
(forall (m :: * -> *) a. Monad m => m a -> TLT m a)
-> MonadTrans TLT
forall (m :: * -> *) a. Monad m => m a -> TLT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> TLT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> TLT m a
MonadTrans, Monad (TLT m)
Monad (TLT m) -> (forall a. IO a -> TLT m a) -> MonadIO (TLT m)
IO a -> TLT m a
forall a. IO a -> TLT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (TLT m)
forall (m :: * -> *) a. MonadIO m => IO a -> TLT m a
liftIO :: IO a -> TLT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> TLT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (TLT m)
MonadIO)
class (Monad m, Monad n) => MonadTLT m n | m -> n where
liftTLT :: TLT n a -> m a
instance Monad m => MonadTLT (TLT m) m where
liftTLT :: TLT m a -> TLT m a
liftTLT = TLT m a -> TLT m a
forall a. a -> a
id
instance (MonadTLT m n, Functor f) => MonadTLT (FreeT f m) n where
liftTLT :: TLT n a -> FreeT f m a
liftTLT = m a -> FreeT f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> FreeT f m a) -> (TLT n a -> m a) -> TLT n a -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance MonadTLT m n => MonadTLT (IdentityT m) n where
liftTLT :: TLT n a -> IdentityT m a
liftTLT = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a)
-> (TLT n a -> m a) -> TLT n a -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance MonadTLT m n => MonadTLT (MaybeT m) n where
liftTLT :: TLT n a -> MaybeT m a
liftTLT = m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a) -> (TLT n a -> m a) -> TLT n a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance MonadTLT m n => MonadTLT (ReaderT r m) n where
liftTLT :: TLT n a -> ReaderT r m a
liftTLT = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (TLT n a -> m a) -> TLT n a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance MonadTLT m n => MonadTLT (ResourceT m) n where
liftTLT :: TLT n a -> ResourceT m a
liftTLT = m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ResourceT m a)
-> (TLT n a -> m a) -> TLT n a -> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance MonadTLT m n => MonadTLT (StateT s m) n where
liftTLT :: TLT n a -> StateT s m a
liftTLT = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (TLT n a -> m a) -> TLT n a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance MonadTLT m n => MonadTLT (SL.StateT s m) n where
liftTLT :: TLT n a -> StateT s m a
liftTLT = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (TLT n a -> m a) -> TLT n a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance MonadTLT m n => MonadTLT (STT s m) n where
liftTLT :: TLT n a -> STT s m a
liftTLT = m a -> STT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> STT s m a) -> (TLT n a -> m a) -> TLT n a -> STT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance (MonadTLT m n, Monoid w) => MonadTLT (WL.WriterT w m) n where
liftTLT :: TLT n a -> WriterT w m a
liftTLT = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (TLT n a -> m a) -> TLT n a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
instance (MonadTLT m n, Monoid w) => MonadTLT (WS.WriterT w m) n where
liftTLT :: TLT n a -> WriterT w m a
liftTLT = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (TLT n a -> m a) -> TLT n a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLT n a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT
tlt :: MonadIO m => TLT m r -> m ()
tlt :: TLT m r -> m ()
tlt TLT m r
tlt = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Running tests:"
(TLTopts
opts, [TestResult]
results) <- TLT m r -> m (TLTopts, [TestResult])
forall (m :: * -> *) r.
MonadIO m =>
TLT m r -> m (TLTopts, [TestResult])
tltCore TLT m r
tlt
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TLTopts -> [TestResult] -> IO ()
report TLTopts
opts ([TestResult] -> IO ()) -> [TestResult] -> IO ()
forall a b. (a -> b) -> a -> b
$ [TestResult]
results
tltCore :: MonadIO m => TLT m r -> m (TLTopts, [TestResult])
tltCore :: TLT m r -> m (TLTopts, [TestResult])
tltCore (TLT StateT TLTstate m r
t) = do
(r
_, (TLTopts
opts, TRBuf
resultsBuf)) <- StateT TLTstate m r -> TLTstate -> m (r, TLTstate)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT TLTstate m r
t (TLTstate -> m (r, TLTstate)) -> TLTstate -> m (r, TLTstate)
forall a b. (a -> b) -> a -> b
$ (TLTopts
defaultOpts, Int -> Int -> [TestResult] -> TRBuf
Top Int
0 Int
0 [])
(TLTopts, [TestResult]) -> m (TLTopts, [TestResult])
forall (m :: * -> *) a. Monad m => a -> m a
return (TLTopts
opts, TRBuf -> [TestResult]
closeTRBuf TRBuf
resultsBuf)
reportAllTestResults :: MonadTLT m n => Bool -> m ()
reportAllTestResults :: Bool -> m ()
reportAllTestResults Bool
b = TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ do
(TLTopts
opts, TRBuf
tr) <- StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTstate -> StateT TLTstate n ())
-> TLTstate -> StateT TLTstate n ()
forall a b. (a -> b) -> a -> b
$ (TLTopts
opts TLTopts -> Bool -> TLTopts
`withShowPasses` Bool
b, TRBuf
tr)
setExitAfterFailDisplay :: MonadTLT m n => Bool -> m ()
setExitAfterFailDisplay :: Bool -> m ()
setExitAfterFailDisplay Bool
b = TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ do
(TLTopts
opts, TRBuf
tr) <- StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTstate -> StateT TLTstate n ())
-> TLTstate -> StateT TLTstate n ()
forall a b. (a -> b) -> a -> b
$ (TLTopts
opts TLTopts -> Bool -> TLTopts
`withExitAfterFail` Bool
b, TRBuf
tr)
tltFail :: MonadTLT m n => String -> String -> m ()
String
desc tltFail :: String -> String -> m ()
`tltFail` String
detail = TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ do
(TLTopts
opts, TRBuf
before) <- StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
let after :: TRBuf
after = TRBuf -> TestResult -> TRBuf
addResult TRBuf
before (TestResult -> TRBuf) -> TestResult -> TRBuf
forall a b. (a -> b) -> a -> b
$ String -> [TestFail] -> TestResult
Test String
desc [String -> TestFail
Asserted String
detail]
TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTopts
opts, TRBuf
after)
inGroup :: MonadTLT m n => String -> m a -> m a
inGroup :: String -> m a -> m a
inGroup String
name m a
group = do
(TLTopts
opts, TRBuf
before) <- TLT n TLTstate -> m TLTstate
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n TLTstate -> m TLTstate) -> TLT n TLTstate -> m TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate -> TLT n TLTstate
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTstate -> StateT TLTstate n ())
-> TLTstate -> StateT TLTstate n ()
forall a b. (a -> b) -> a -> b
$ (TLTopts
opts, TRBuf -> Int -> Int -> String -> [TestResult] -> TRBuf
Buf TRBuf
before Int
0 Int
0 String
name [])
a
result <- m a
group
(TLTopts
opts', TRBuf
after) <- TLT n TLTstate -> m TLTstate
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n TLTstate -> m TLTstate) -> TLT n TLTstate -> m TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate -> TLT n TLTstate
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n TLTstate -> TLT n TLTstate)
-> StateT TLTstate n TLTstate -> TLT n TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTstate -> StateT TLTstate n ())
-> TLTstate -> StateT TLTstate n ()
forall a b. (a -> b) -> a -> b
$ (TLTopts
opts', TRBuf -> TRBuf
popGroup TRBuf
after)
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
infix 0 ~:, ~::, ~::-
(~:) :: MonadTLT m n => String -> Assertion m -> m ()
String
s ~: :: String -> Assertion m -> m ()
~: Assertion m
a = do
(TLTopts
opts, TRBuf
oldState) <- TLT n TLTstate -> m TLTstate
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n TLTstate -> m TLTstate) -> TLT n TLTstate -> m TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate -> TLT n TLTstate
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n TLTstate -> TLT n TLTstate)
-> StateT TLTstate n TLTstate -> TLT n TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
[TestFail]
assessment <- Assertion m
a
TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTopts
opts, TRBuf -> TestResult -> TRBuf
addResult TRBuf
oldState (TestResult -> TRBuf) -> TestResult -> TRBuf
forall a b. (a -> b) -> a -> b
$ String -> [TestFail] -> TestResult
Test String
s [TestFail]
assessment)
(~::-) :: MonadTLT m n => String -> Bool -> m ()
String
s ~::- :: String -> Bool -> m ()
~::- Bool
b = do
(TLTopts
opts, TRBuf
oldState) <- TLT n TLTstate -> m TLTstate
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n TLTstate -> m TLTstate) -> TLT n TLTstate -> m TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate -> TLT n TLTstate
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n TLTstate -> TLT n TLTstate)
-> StateT TLTstate n TLTstate -> TLT n TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTopts
opts, TRBuf -> TestResult -> TRBuf
addResult TRBuf
oldState (TestResult -> TRBuf) -> TestResult -> TRBuf
forall a b. (a -> b) -> a -> b
$ String -> [TestFail] -> TestResult
Test String
s ([TestFail] -> TestResult) -> [TestFail] -> TestResult
forall a b. (a -> b) -> a -> b
$
if Bool
b then [] else [String -> TestFail
Asserted (String -> TestFail) -> String -> TestFail
forall a b. (a -> b) -> a -> b
$ String
"Expected True but got False"])
(~::) :: MonadTLT m n => String -> m Bool -> m ()
String
s ~:: :: String -> m Bool -> m ()
~:: m Bool
bM = do
Bool
b <- m Bool
bM
(TLTopts
opts, TRBuf
oldState) <- TLT n TLTstate -> m TLTstate
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n TLTstate -> m TLTstate) -> TLT n TLTstate -> m TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate -> TLT n TLTstate
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n TLTstate -> TLT n TLTstate)
-> StateT TLTstate n TLTstate -> TLT n TLTstate
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n TLTstate
forall (m :: * -> *) s. Monad m => StateT s m s
get
TLT n () -> m ()
forall (m :: * -> *) (n :: * -> *) a.
MonadTLT m n =>
TLT n a -> m a
liftTLT (TLT n () -> m ()) -> TLT n () -> m ()
forall a b. (a -> b) -> a -> b
$ StateT TLTstate n () -> TLT n ()
forall (m :: * -> *) r. StateT TLTstate m r -> TLT m r
TLT (StateT TLTstate n () -> TLT n ())
-> StateT TLTstate n () -> TLT n ()
forall a b. (a -> b) -> a -> b
$ TLTstate -> StateT TLTstate n ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TLTopts
opts, TRBuf -> TestResult -> TRBuf
addResult TRBuf
oldState (TestResult -> TRBuf) -> TestResult -> TRBuf
forall a b. (a -> b) -> a -> b
$ String -> [TestFail] -> TestResult
Test String
s ([TestFail] -> TestResult) -> [TestFail] -> TestResult
forall a b. (a -> b) -> a -> b
$
if Bool
b then [] else [String -> TestFail
Asserted (String -> TestFail) -> String -> TestFail
forall a b. (a -> b) -> a -> b
$ String
"Expected True but got False"])
infix 1 @==, @/=, @<, @>, @<=, @>=
infix 1 @==-, @/=-, @<-, @>-, @<=-, @>=-
liftAssertion2Pure ::
(Monad m) => (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure :: (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
tester a -> a -> String
explainer a
exp a
actual = [TestFail] -> Assertion m
forall (m :: * -> *) a. Monad m => a -> m a
return ([TestFail] -> Assertion m) -> [TestFail] -> Assertion m
forall a b. (a -> b) -> a -> b
$
if (a -> a -> Bool
tester a
exp a
actual) then [] else [String -> TestFail
Asserted (String -> TestFail) -> String -> TestFail
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 :: (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 :: (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 = (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
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
(@==-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m
@==- :: a -> a -> Assertion m
(@==-) = (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((a -> a -> String) -> a -> a -> Assertion m)
-> (a -> a -> String) -> a -> a -> Assertion m
forall a b. (a -> b) -> a -> b
$
\ a
exp a
actual -> String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
exp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual
(@==) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m
@== :: a -> m a -> Assertion m
(@==) = (a -> a -> Assertion m) -> a -> m a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM a -> a -> Assertion m
forall (m :: * -> *) a.
(Monad m, Eq a, Show a) =>
a -> a -> Assertion m
(@==-)
(@/=-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m
@/=- :: a -> a -> Assertion m
(@/=-) = (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) ((a -> a -> String) -> a -> a -> Assertion m)
-> (a -> a -> String) -> a -> a -> Assertion m
forall a b. (a -> b) -> a -> b
$
\ a
exp a
actual ->
String
"Expected other than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
exp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual
(@/=) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m
@/= :: a -> m a -> Assertion m
(@/=) = (a -> a -> Assertion m) -> a -> m a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM a -> a -> Assertion m
forall (m :: * -> *) a.
(Monad m, Eq a, Show a) =>
a -> a -> Assertion m
(@/=-)
(@<-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m
@<- :: a -> a -> Assertion m
(@<-) = (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) ((a -> a -> String) -> a -> a -> Assertion m)
-> (a -> a -> String) -> a -> a -> Assertion m
forall a b. (a -> b) -> a -> b
$
\ a
exp a
actual ->
String
"Lower bound (open) is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
exp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual
(@<) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m
@< :: a -> m a -> Assertion m
(@<) = (a -> a -> Assertion m) -> a -> m a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM a -> a -> Assertion m
forall (m :: * -> *) a.
(Monad m, Ord a, Show a) =>
a -> a -> Assertion m
(@<-)
(@>-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m
@>- :: a -> a -> Assertion m
(@>-) = (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) ((a -> a -> String) -> a -> a -> Assertion m)
-> (a -> a -> String) -> a -> a -> Assertion m
forall a b. (a -> b) -> a -> b
$
\ a
exp a
actual ->
String
"Upper bound (open) is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
exp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual
(@>) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m
@> :: a -> m a -> Assertion m
(@>) = (a -> a -> Assertion m) -> a -> m a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM a -> a -> Assertion m
forall (m :: * -> *) a.
(Monad m, Ord a, Show a) =>
a -> a -> Assertion m
(@>-)
(@<=-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m
@<=- :: a -> a -> Assertion m
(@<=-) = (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ((a -> a -> String) -> a -> a -> Assertion m)
-> (a -> a -> String) -> a -> a -> Assertion m
forall a b. (a -> b) -> a -> b
$
\ a
exp a
actual ->
String
"Lower bound (closed) is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
exp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual
(@<=) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m
@<= :: a -> m a -> Assertion m
(@<=) = (a -> a -> Assertion m) -> a -> m a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM a -> a -> Assertion m
forall (m :: * -> *) a.
(Monad m, Ord a, Show a) =>
a -> a -> Assertion m
(@<=-)
(@>=-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m
@>=- :: a -> a -> Assertion m
(@>=-) = (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m
liftAssertion2Pure a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) ((a -> a -> String) -> a -> a -> Assertion m)
-> (a -> a -> String) -> a -> a -> Assertion m
forall a b. (a -> b) -> a -> b
$
\ a
exp a
actual ->
String
"Upper bound (closed) is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
exp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual
(@>=) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m
@>= :: a -> m a -> Assertion m
(@>=) = (a -> a -> Assertion m) -> a -> m a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Assertion m) -> a -> m a -> Assertion m
assertion2PtoM a -> a -> Assertion m
forall (m :: * -> *) a.
(Monad m, Ord a, Show a) =>
a -> a -> Assertion m
(@>=-)
assertFailed :: Monad m => String -> Assertion m
assertFailed :: String -> Assertion m
assertFailed String
msg = [TestFail] -> Assertion m
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> TestFail
Asserted String
msg]
assertSuccess :: Monad m => Assertion m
assertSuccess :: Assertion m
assertSuccess = [TestFail] -> Assertion m
forall (m :: * -> *) a. Monad m => a -> m a
return []
liftAssertionPure ::
(Monad m) => (a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure :: (a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure a -> Bool
tester a -> String
explainer a
actual = [TestFail] -> Assertion m
forall (m :: * -> *) a. Monad m => a -> m a
return ([TestFail] -> Assertion m) -> [TestFail] -> Assertion m
forall a b. (a -> b) -> a -> b
$
if (a -> Bool
tester a
actual) then [] else [String -> TestFail
Asserted (String -> TestFail) -> String -> TestFail
forall a b. (a -> b) -> a -> b
$ a -> String
explainer a
actual]
assertionPtoM :: (Monad m) => (a -> Assertion m) -> m a -> Assertion m
assertionPtoM :: (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 :: (a -> Bool) -> (a -> String) -> m a -> Assertion m
liftAssertionM a -> Bool
tester a -> String
explainer m a
actualM =
let assertPure :: a -> Assertion m
assertPure = (a -> Bool) -> (a -> String) -> a -> Assertion m
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
emptyP :: (Monad m, Traversable t) => t a -> Assertion m
emptyP :: t a -> Assertion m
emptyP = (t a -> Bool) -> (t a -> String) -> t a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
(\ t a
_ -> String
"Expected empty structure but got non-empty")
empty :: (Monad m, Traversable t) => m (t a) -> Assertion m
empty :: m (t a) -> Assertion m
empty = (t a -> Assertion m) -> m (t a) -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> Assertion m) -> m a -> Assertion m
assertionPtoM t a -> Assertion m
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
t a -> Assertion m
emptyP
nonemptyP :: (Monad m, Traversable t) => t a -> Assertion m
nonemptyP :: t a -> Assertion m
nonemptyP = (t a -> Bool) -> (t a -> String) -> t a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure (Bool -> Bool
not (Bool -> Bool) -> (t a -> Bool) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
(\ t a
_ -> String
"Expected non-empty structure but got empty")
nonempty :: (Monad m, Traversable t) => m (t a) -> Assertion m
nonempty :: m (t a) -> Assertion m
nonempty = (t a -> Assertion m) -> m (t a) -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> Assertion m) -> m a -> Assertion m
assertionPtoM t a -> Assertion m
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
t a -> Assertion m
nonemptyP
nothingP :: Monad m => Maybe a -> Assertion m
nothingP :: Maybe a -> Assertion m
nothingP = (Maybe a -> Bool) -> (Maybe a -> String) -> Maybe a -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> String) -> a -> Assertion m
liftAssertionPure Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing
(\ Maybe a
_ -> String
"Expected empty Maybe value but got non-Nothing")
nothing :: Monad m => m (Maybe a) -> Assertion m
nothing :: m (Maybe a) -> Assertion m
nothing = (Maybe a -> Assertion m) -> m (Maybe a) -> Assertion m
forall (m :: * -> *) a.
Monad m =>
(a -> Assertion m) -> m a -> Assertion m
assertionPtoM Maybe a -> Assertion m
forall (m :: * -> *) a. Monad m => Maybe a -> Assertion m
nothingP