{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Test.Chell
(
defaultMain
, Suite
, suite
, suiteName
, suiteTests
, SuiteOrTest
, skipIf
, skipWhen
, Assertions
, assertions
, IsAssertion
, Assertion
, assertionPassed
, assertionFailed
, assert
, expect
, die
, trace
, note
, afterTest
, requireLeft
, requireRight
, equal
, notEqual
, equalWithin
, just
, nothing
, left
, right
, throws
, throwsEq
, greater
, greaterEqual
, lesser
, lesserEqual
, sameItems
, equalItems
, IsText
, equalLines
, equalLinesWith
, Test
, test
, testName
, runTest
, TestResult (..)
, Failure
, failure
, failureLocation
, failureMessage
, Location
, location
, locationFile
, locationModule
, locationLine
, TestOptions
, defaultTestOptions
, testOptionSeed
, testOptionTimeout
) where
import qualified Control.Applicative
import qualified Control.Exception
import Control.Exception (Exception)
import Control.Monad (ap, liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.ByteString.Char8
import qualified Data.ByteString.Lazy.Char8
import Data.Foldable (Foldable, foldMap)
import Data.List (foldl', intercalate, sort)
import Data.Maybe (isJust, isNothing)
import Data.IORef (IORef, newIORef, readIORef, modifyIORef)
import qualified Data.Text
import Data.Text (Text)
import qualified Data.Text.Lazy
import qualified Language.Haskell.TH as TH
import qualified Patience
import Test.Chell.Main (defaultMain)
import Test.Chell.Types
data Assertion
= AssertionPassed
| AssertionFailed String
deriving (Assertion -> Assertion -> Bool
(Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool) -> Eq Assertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c== :: Assertion -> Assertion -> Bool
Eq, Int -> Assertion -> ShowS
[Assertion] -> ShowS
Assertion -> String
(Int -> Assertion -> ShowS)
-> (Assertion -> String)
-> ([Assertion] -> ShowS)
-> Show Assertion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assertion] -> ShowS
$cshowList :: [Assertion] -> ShowS
show :: Assertion -> String
$cshow :: Assertion -> String
showsPrec :: Int -> Assertion -> ShowS
$cshowsPrec :: Int -> Assertion -> ShowS
Show)
assertionPassed :: Assertion
assertionPassed :: Assertion
assertionPassed = Assertion
AssertionPassed
assertionFailed :: String -> Assertion
assertionFailed :: String -> Assertion
assertionFailed = String -> Assertion
AssertionFailed
class IsAssertion a
where
runAssertion :: a -> IO Assertion
instance IsAssertion Assertion
where
runAssertion :: Assertion -> IO Assertion
runAssertion = Assertion -> IO Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return
instance IsAssertion Bool
where
runAssertion :: Bool -> IO Assertion
runAssertion Bool
x =
Assertion -> IO Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return
(
if Bool
x
then Assertion
assertionPassed
else String -> Assertion
assertionFailed String
"boolean assertion failed"
)
instance IsAssertion a => IsAssertion (IO a)
where
runAssertion :: IO a -> IO Assertion
runAssertion IO a
x = IO a
x IO a -> (a -> IO Assertion) -> IO Assertion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO Assertion
forall a. IsAssertion a => a -> IO Assertion
runAssertion
type TestState = (IORef [(String, String)], IORef [IO ()], [Failure])
newtype Assertions a =
Assertions
{ Assertions a -> TestState -> IO (Maybe a, TestState)
unAssertions :: TestState -> IO (Maybe a, TestState) }
instance Functor Assertions
where
fmap :: (a -> b) -> Assertions a -> Assertions b
fmap = (a -> b) -> Assertions a -> Assertions b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Control.Applicative.Applicative Assertions
where
pure :: a -> Assertions a
pure = a -> Assertions a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: Assertions (a -> b) -> Assertions a -> Assertions b
(<*>) = Assertions (a -> b) -> Assertions a -> Assertions b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Assertions
where
return :: a -> Assertions a
return a
x =
(TestState -> IO (Maybe a, TestState)) -> Assertions a
forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions (\TestState
s -> (Maybe a, TestState) -> IO (Maybe a, TestState)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x, TestState
s))
Assertions a
m >>= :: Assertions a -> (a -> Assertions b) -> Assertions b
>>= a -> Assertions b
f =
(TestState -> IO (Maybe b, TestState)) -> Assertions b
forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions
(\TestState
s ->
do
(Maybe a
maybe_a, TestState
s') <- Assertions a -> TestState -> IO (Maybe a, TestState)
forall a. Assertions a -> TestState -> IO (Maybe a, TestState)
unAssertions Assertions a
m TestState
s
case Maybe a
maybe_a of
Maybe a
Nothing -> (Maybe b, TestState) -> IO (Maybe b, TestState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b
forall a. Maybe a
Nothing, TestState
s')
Just a
a -> Assertions b -> TestState -> IO (Maybe b, TestState)
forall a. Assertions a -> TestState -> IO (Maybe a, TestState)
unAssertions (a -> Assertions b
f a
a) TestState
s'
)
instance MonadIO Assertions
where
liftIO :: IO a -> Assertions a
liftIO IO a
io =
(TestState -> IO (Maybe a, TestState)) -> Assertions a
forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions
(\TestState
s ->
do
a
x <- IO a
io
(Maybe a, TestState) -> IO (Maybe a, TestState)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x, TestState
s)
)
assertions :: String -> Assertions a -> Test
assertions :: String -> Assertions a -> Test
assertions String
name Assertions a
testm =
String -> (TestOptions -> IO TestResult) -> Test
test String
name ((TestOptions -> IO TestResult) -> Test)
-> (TestOptions -> IO TestResult) -> Test
forall a b. (a -> b) -> a -> b
$ \TestOptions
opts ->
do
IORef [(String, String)]
noteRef <- [(String, String)] -> IO (IORef [(String, String)])
forall a. a -> IO (IORef a)
newIORef []
IORef [IO ()]
afterTestRef <- [IO ()] -> IO (IORef [IO ()])
forall a. a -> IO (IORef a)
newIORef []
let
getNotes :: IO [(String, String)]
getNotes = ([(String, String)] -> [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse (IORef [(String, String)] -> IO [(String, String)]
forall a. IORef a -> IO a
readIORef IORef [(String, String)]
noteRef)
let
getResult :: IO TestResult
getResult =
do
(Maybe a, TestState)
res <- Assertions a -> TestState -> IO (Maybe a, TestState)
forall a. Assertions a -> TestState -> IO (Maybe a, TestState)
unAssertions Assertions a
testm (IORef [(String, String)]
noteRef, IORef [IO ()]
afterTestRef, [])
case (Maybe a, TestState)
res of
(Maybe a
_, (IORef [(String, String)]
_, IORef [IO ()]
_, [])) ->
do
[(String, String)]
notes <- IO [(String, String)]
getNotes
TestResult -> IO TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)] -> TestResult
TestPassed [(String, String)]
notes)
(Maybe a
_, (IORef [(String, String)]
_, IORef [IO ()]
_, [Failure]
fs)) ->
do
[(String, String)]
notes <- IO [(String, String)]
getNotes
TestResult -> IO TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)] -> [Failure] -> TestResult
TestFailed [(String, String)]
notes ([Failure] -> [Failure]
forall a. [a] -> [a]
reverse [Failure]
fs))
IO TestResult -> IO () -> IO TestResult
forall a b. IO a -> IO b -> IO a
Control.Exception.finally
(TestOptions
-> IO TestResult -> IO [(String, String)] -> IO TestResult
handleJankyIO TestOptions
opts IO TestResult
getResult IO [(String, String)]
getNotes)
(IORef [IO ()] -> IO ()
runAfterTest IORef [IO ()]
afterTestRef)
runAfterTest :: IORef [IO ()] -> IO ()
runAfterTest :: IORef [IO ()] -> IO ()
runAfterTest IORef [IO ()]
ref = IORef [IO ()] -> IO [IO ()]
forall a. IORef a -> IO a
readIORef IORef [IO ()]
ref IO [IO ()] -> ([IO ()] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [IO ()] -> IO ()
forall b. [IO b] -> IO ()
loop
where
loop :: [IO b] -> IO ()
loop [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop (IO b
io:[IO b]
ios) = IO () -> IO b -> IO ()
forall a b. IO a -> IO b -> IO a
Control.Exception.finally ([IO b] -> IO ()
loop [IO b]
ios) IO b
io
addFailure :: Maybe TH.Loc -> String -> Assertions ()
addFailure :: Maybe Loc -> String -> Assertions ()
addFailure Maybe Loc
maybe_loc String
msg =
(TestState -> IO (Maybe (), TestState)) -> Assertions ()
forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions ((TestState -> IO (Maybe (), TestState)) -> Assertions ())
-> (TestState -> IO (Maybe (), TestState)) -> Assertions ()
forall a b. (a -> b) -> a -> b
$ \(IORef [(String, String)]
notes, IORef [IO ()]
afterTestRef, [Failure]
fs) ->
do
let
loc :: Maybe Location
loc =
do
Loc
th_loc <- Maybe Loc
maybe_loc
Location -> Maybe Location
forall (m :: * -> *) a. Monad m => a -> m a
return (Location -> Maybe Location) -> Location -> Maybe Location
forall a b. (a -> b) -> a -> b
$ Location
location
{ locationFile :: String
locationFile = Loc -> String
TH.loc_filename Loc
th_loc
, locationModule :: String
locationModule = Loc -> String
TH.loc_module Loc
th_loc
, locationLine :: Maybe Integer
locationLine = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int -> Integer
forall a. Integral a => a -> Integer
toInteger ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Loc -> (Int, Int)
TH.loc_start Loc
th_loc)))
}
let
f :: Failure
f = Failure
failure
{ failureLocation :: Maybe Location
failureLocation = Maybe Location
loc
, failureMessage :: String
failureMessage = String
msg
}
(Maybe (), TestState) -> IO (Maybe (), TestState)
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Maybe ()
forall a. a -> Maybe a
Just (), (IORef [(String, String)]
notes, IORef [IO ()]
afterTestRef, Failure
f Failure -> [Failure] -> [Failure]
forall a. a -> [a] -> [a]
: [Failure]
fs))
die :: TH.Q TH.Exp
die :: Q Exp
die =
do
Loc
loc <- Q Loc
TH.location
let
qloc :: Q Exp
qloc = Loc -> Q Exp
liftLoc Loc
loc
[| \msg -> dieAt $qloc ("die: " ++ msg) |]
dieAt :: TH.Loc -> String -> Assertions a
dieAt :: Loc -> String -> Assertions a
dieAt Loc
loc String
msg =
do
Maybe Loc -> String -> Assertions ()
addFailure (Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
loc) String
msg
(TestState -> IO (Maybe a, TestState)) -> Assertions a
forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions (\TestState
s -> (Maybe a, TestState) -> IO (Maybe a, TestState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, TestState
s))
trace :: TH.Q TH.Exp
trace :: Q Exp
trace =
do
Loc
loc <- Q Loc
TH.location
let
qloc :: Q Exp
qloc = Loc -> Q Exp
liftLoc Loc
loc
[| traceAt $qloc |]
traceAt :: TH.Loc -> String -> Assertions ()
traceAt :: Loc -> String -> Assertions ()
traceAt Loc
loc String
msg =
IO () -> Assertions ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Assertions ()) -> IO () -> Assertions ()
forall a b. (a -> b) -> a -> b
$
do
let
file :: String
file = Loc -> String
TH.loc_filename Loc
loc
line :: Int
line = (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Loc -> (Int, Int)
TH.loc_start Loc
loc)
String -> IO ()
putStr (String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] ")
String -> IO ()
putStrLn String
msg
note :: String -> String -> Assertions ()
note :: String -> String -> Assertions ()
note String
key String
value =
(TestState -> IO (Maybe (), TestState)) -> Assertions ()
forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions (\(IORef [(String, String)]
notes, IORef [IO ()]
afterTestRef, [Failure]
fs) ->
do
IORef [(String, String)]
-> ([(String, String)] -> [(String, String)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(String, String)]
notes ((String
key, String
value) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)
(Maybe (), TestState) -> IO (Maybe (), TestState)
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Maybe ()
forall a. a -> Maybe a
Just (), (IORef [(String, String)]
notes, IORef [IO ()]
afterTestRef, [Failure]
fs)))
afterTest :: IO () -> Assertions ()
afterTest :: IO () -> Assertions ()
afterTest IO ()
io =
(TestState -> IO (Maybe (), TestState)) -> Assertions ()
forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions (\(IORef [(String, String)]
notes, IORef [IO ()]
ref, [Failure]
fs) ->
do
IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [IO ()]
ref (IO ()
io IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)
(Maybe (), TestState) -> IO (Maybe (), TestState)
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Maybe ()
forall a. a -> Maybe a
Just (), (IORef [(String, String)]
notes, IORef [IO ()]
ref, [Failure]
fs)))
requireLeft :: TH.Q TH.Exp
requireLeft :: Q Exp
requireLeft =
do
Loc
loc <- Q Loc
TH.location
let
qloc :: Q Exp
qloc = Loc -> Q Exp
liftLoc Loc
loc
[| requireLeftAt $qloc |]
requireLeftAt :: Show b => TH.Loc -> Either a b -> Assertions a
requireLeftAt :: Loc -> Either a b -> Assertions a
requireLeftAt Loc
loc Either a b
val =
case Either a b
val of
Left a
a -> a -> Assertions a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Right b
b ->
do
let
dummy :: Either () b
dummy = b -> Either () b
forall a b. b -> Either a b
Right b
b Either () b -> Either () b -> Either () b
forall a. a -> a -> a
`asTypeOf` () -> Either () b
forall a b. a -> Either a b
Left ()
Loc -> String -> Assertions a
forall a. Loc -> String -> Assertions a
dieAt Loc
loc (String
"requireLeft: received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Either () b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either () b
dummy String
"")
requireRight :: TH.Q TH.Exp
requireRight :: Q Exp
requireRight =
do
Loc
loc <- Q Loc
TH.location
let
qloc :: Q Exp
qloc = Loc -> Q Exp
liftLoc Loc
loc
[| requireRightAt $qloc |]
requireRightAt :: Show a => TH.Loc -> Either a b -> Assertions b
requireRightAt :: Loc -> Either a b -> Assertions b
requireRightAt Loc
loc Either a b
val =
case Either a b
val of
Left a
a ->
do
let
dummy :: Either a ()
dummy = a -> Either a ()
forall a b. a -> Either a b
Left a
a Either a () -> Either a () -> Either a ()
forall a. a -> a -> a
`asTypeOf` () -> Either a ()
forall a b. b -> Either a b
Right ()
Loc -> String -> Assertions b
forall a. Loc -> String -> Assertions a
dieAt Loc
loc (String
"requireRight: received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Either a () -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either a ()
dummy String
"")
Right b
b -> b -> Assertions b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
liftLoc :: TH.Loc -> TH.Q TH.Exp
liftLoc :: Loc -> Q Exp
liftLoc Loc
loc =
[| TH.Loc filename package module_ start end |]
where
filename :: String
filename = Loc -> String
TH.loc_filename Loc
loc
package :: String
package = Loc -> String
TH.loc_package Loc
loc
module_ :: String
module_ = Loc -> String
TH.loc_module Loc
loc
start :: (Int, Int)
start = Loc -> (Int, Int)
TH.loc_start Loc
loc
end :: (Int, Int)
end = Loc -> (Int, Int)
TH.loc_end Loc
loc
assertAt :: IsAssertion assertion => TH.Loc -> Bool -> assertion -> Assertions ()
assertAt :: Loc -> Bool -> assertion -> Assertions ()
assertAt Loc
loc Bool
fatal assertion
assertion =
do
Assertion
result <- IO Assertion -> Assertions Assertion
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (assertion -> IO Assertion
forall a. IsAssertion a => a -> IO Assertion
runAssertion assertion
assertion)
case Assertion
result of
Assertion
AssertionPassed -> () -> Assertions ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
AssertionFailed String
err ->
if Bool
fatal
then Loc -> String -> Assertions ()
forall a. Loc -> String -> Assertions a
dieAt Loc
loc String
err
else Maybe Loc -> String -> Assertions ()
addFailure (Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
loc) String
err
assert :: TH.Q TH.Exp
assert :: Q Exp
assert =
do
Loc
loc <- Q Loc
TH.location
let
qloc :: Q Exp
qloc = Loc -> Q Exp
liftLoc Loc
loc
[| assertAt $qloc True |]
expect :: TH.Q TH.Exp
expect :: Q Exp
expect =
do
Loc
loc <- Q Loc
TH.location
let
qloc :: Q Exp
qloc = Loc -> Q Exp
liftLoc Loc
loc
[| assertAt $qloc False |]
assertBool :: Bool -> String -> Assertion
assertBool :: Bool -> String -> Assertion
assertBool Bool
True String
_ = Assertion
assertionPassed
assertBool Bool
False String
err = String -> Assertion
AssertionFailed String
err
equal :: (Show a, Eq a) => a -> a -> Assertion
equal :: a -> a -> Assertion
equal a
x a
y =
Bool -> String -> Assertion
assertBool
(a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y)
(String
"equal: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not equal to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
notEqual :: (Eq a, Show a) => a -> a -> Assertion
notEqual :: a -> a -> Assertion
notEqual a
x a
y =
Bool -> String -> Assertion
assertBool
(a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y)
(String
"notEqual: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is equal to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
equalWithin :: (Real a, Show a) => a -> a
-> a
-> Assertion
equalWithin :: a -> a -> a -> Assertion
equalWithin a
x a
y a
delta =
Bool -> String -> Assertion
assertBool
((a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
delta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y) Bool -> Bool -> Bool
&& (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
delta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y))
(String
"equalWithin: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not within " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
delta String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
just :: Maybe a -> Assertion
just :: Maybe a -> Assertion
just Maybe a
x = Bool -> String -> Assertion
assertBool (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
x) (String
"just: received Nothing")
nothing :: Show a => Maybe a -> Assertion
nothing :: Maybe a -> Assertion
nothing Maybe a
x =
Bool -> String -> Assertion
assertBool
(Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
x)
(String
"nothing: received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Maybe a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe a
x String
"")
left :: Show b => Either a b -> Assertion
left :: Either a b -> Assertion
left (Left a
_) = Assertion
assertionPassed
left (Right b
b) = String -> Assertion
assertionFailed (String
"left: received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Either () b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either () b
dummy String
"")
where
dummy :: Either () b
dummy = b -> Either () b
forall a b. b -> Either a b
Right b
b Either () b -> Either () b -> Either () b
forall a. a -> a -> a
`asTypeOf` () -> Either () b
forall a b. a -> Either a b
Left ()
right :: Show a => Either a b -> Assertion
right :: Either a b -> Assertion
right (Right b
_) = Assertion
assertionPassed
right (Left a
a) = String -> Assertion
assertionFailed (String
"right: received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Either a () -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either a ()
dummy String
"")
where
dummy :: Either a ()
dummy = a -> Either a ()
forall a b. a -> Either a b
Left a
a Either a () -> Either a () -> Either a ()
forall a. a -> a -> a
`asTypeOf` () -> Either a ()
forall a b. b -> Either a b
Right ()
throws :: Exception err => (err -> Bool) -> IO a -> IO Assertion
throws :: (err -> Bool) -> IO a -> IO Assertion
throws err -> Bool
p IO a
io =
do
Either err a
either_exc <- IO a -> IO (Either err a)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try IO a
io
Assertion -> IO Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return (Assertion -> IO Assertion) -> Assertion -> IO Assertion
forall a b. (a -> b) -> a -> b
$
case Either err a
either_exc of
Left err
exc ->
if err -> Bool
p err
exc
then Assertion
assertionPassed
else String -> Assertion
assertionFailed (String
"throws: exception " String -> ShowS
forall a. [a] -> [a] -> [a]
++ err -> String
forall a. Show a => a -> String
show err
exc String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" did not match predicate")
Right a
_ -> String -> Assertion
assertionFailed String
"throws: no exception thrown"
throwsEq :: (Eq err, Exception err, Show err) => err -> IO a -> IO Assertion
throwsEq :: err -> IO a -> IO Assertion
throwsEq err
expected IO a
io =
do
Either err a
either_exc <- IO a -> IO (Either err a)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try IO a
io
Assertion -> IO Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return (Assertion -> IO Assertion) -> Assertion -> IO Assertion
forall a b. (a -> b) -> a -> b
$
case Either err a
either_exc of
Left err
exc ->
if err
exc err -> err -> Bool
forall a. Eq a => a -> a -> Bool
== err
expected
then Assertion
assertionPassed
else String -> Assertion
assertionFailed (String
"throwsEq: exception " String -> ShowS
forall a. [a] -> [a] -> [a]
++ err -> String
forall a. Show a => a -> String
show err
exc String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" is not equal to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ err -> String
forall a. Show a => a -> String
show err
expected)
Right a
_ -> String -> Assertion
assertionFailed String
"throwsEq: no exception thrown"
greater :: (Ord a, Show a) => a -> a -> Assertion
greater :: a -> a -> Assertion
greater a
x a
y =
Bool -> String -> Assertion
assertBool
(a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y)
(String
"greater: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not greater than " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
greaterEqual :: (Ord a, Show a) => a -> a -> Assertion
greaterEqual :: a -> a -> Assertion
greaterEqual a
x a
y =
Bool -> String -> Assertion
assertBool
(a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y)
(String
"greaterEqual: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not greater than or equal to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
lesser :: (Ord a, Show a) => a -> a -> Assertion
lesser :: a -> a -> Assertion
lesser a
x a
y =
Bool -> String -> Assertion
assertBool
(a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y)
(String
"lesser: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not less than " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
lesserEqual :: (Ord a, Show a) => a -> a -> Assertion
lesserEqual :: a -> a -> Assertion
lesserEqual a
x a
y =
Bool -> String -> Assertion
assertBool
(a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y)
(String
"lesserEqual: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not less than or equal to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
sameItems :: (Foldable container, Show item, Ord item) =>
container item -> container item -> Assertion
sameItems :: container item -> container item -> Assertion
sameItems container item
x container item
y = String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
forall (container :: * -> *) item.
(Foldable container, Show item, Ord item) =>
String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
equalDiff' String
"sameItems" [item] -> [item]
forall a. Ord a => [a] -> [a]
sort container item
x container item
y
equalItems :: (Foldable container, Show item, Ord item) =>
container item -> container item -> Assertion
equalItems :: container item -> container item -> Assertion
equalItems container item
x container item
y = String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
forall (container :: * -> *) item.
(Foldable container, Show item, Ord item) =>
String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
equalDiff' String
"equalItems" [item] -> [item]
forall a. a -> a
id container item
x container item
y
equalDiff' :: (Foldable container, Show item, Ord item)
=> String
-> ([item]
-> [item])
-> container item
-> container item
-> Assertion
equalDiff' :: String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
equalDiff' String
label [item] -> [item]
norm container item
x container item
y = [item] -> [item] -> Assertion
forall a. (Show a, Ord a) => [a] -> [a] -> Assertion
checkDiff (container item -> [item]
items container item
x) (container item -> [item]
items container item
y)
where
items :: container item -> [item]
items = [item] -> [item]
norm ([item] -> [item])
-> (container item -> [item]) -> container item -> [item]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (item -> [item]) -> container item -> [item]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (item -> [item] -> [item]
forall a. a -> [a] -> [a]
:[])
checkDiff :: [a] -> [a] -> Assertion
checkDiff [a]
xs [a]
ys =
case [Item a] -> (Bool, String)
forall (t :: * -> *) a.
(Foldable t, Show a) =>
t (Item a) -> (Bool, String)
checkItems ([a] -> [a] -> [Item a]
forall a. Ord a => [a] -> [a] -> [Item a]
Patience.diff [a]
xs [a]
ys) of
(Bool
same, String
diff) -> Bool -> String -> Assertion
assertBool Bool
same String
diff
checkItems :: t (Item a) -> (Bool, String)
checkItems t (Item a)
diffItems =
case ((Bool, [String]) -> Item a -> (Bool, [String]))
-> (Bool, [String]) -> t (Item a) -> (Bool, [String])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool, [String]) -> Item a -> (Bool, [String])
forall a. Show a => (Bool, [String]) -> Item a -> (Bool, [String])
checkItem (Bool
True, []) t (Item a)
diffItems of
(Bool
same, [String]
diff) -> (Bool
same, ShowS
errorMsg (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
diff)))
checkItem :: (Bool, [String]) -> Item a -> (Bool, [String])
checkItem (Bool
same, [String]
acc) Item a
item =
case Item a
item of
Patience.Old a
t -> (Bool
False, (String
"\t- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc)
Patience.New a
t -> (Bool
False, (String
"\t+ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc)
Patience.Both a
t a
_-> (Bool
same, (String
"\t " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc)
errorMsg :: ShowS
errorMsg String
diff = String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": items differ\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
diff
class IsText a
where
toLines :: a -> [a]
unpack :: a -> String
instance IsText String
where
toLines :: String -> [String]
toLines = String -> [String]
lines
unpack :: ShowS
unpack = ShowS
forall a. a -> a
id
instance IsText Text
where
toLines :: Text -> [Text]
toLines = Text -> [Text]
Data.Text.lines
unpack :: Text -> String
unpack = Text -> String
Data.Text.unpack
instance IsText Data.Text.Lazy.Text
where
toLines :: Text -> [Text]
toLines = Text -> [Text]
Data.Text.Lazy.lines
unpack :: Text -> String
unpack = Text -> String
Data.Text.Lazy.unpack
instance IsText Data.ByteString.Char8.ByteString
where
toLines :: ByteString -> [ByteString]
toLines = ByteString -> [ByteString]
Data.ByteString.Char8.lines
unpack :: ByteString -> String
unpack = ByteString -> String
Data.ByteString.Char8.unpack
instance IsText Data.ByteString.Lazy.Char8.ByteString
where
toLines :: ByteString -> [ByteString]
toLines = ByteString -> [ByteString]
Data.ByteString.Lazy.Char8.lines
unpack :: ByteString -> String
unpack = ByteString -> String
Data.ByteString.Lazy.Char8.unpack
equalLines :: (Ord a, IsText a) => a -> a -> Assertion
equalLines :: a -> a -> Assertion
equalLines a
x a
y = String -> [a] -> [a] -> Assertion
forall a. (Ord a, IsText a) => String -> [a] -> [a] -> Assertion
checkLinesDiff String
"equalLines" (a -> [a]
forall a. IsText a => a -> [a]
toLines a
x) (a -> [a]
forall a. IsText a => a -> [a]
toLines a
y)
equalLinesWith :: Ord a => (a -> [String]) -> a -> a -> Assertion
equalLinesWith :: (a -> [String]) -> a -> a -> Assertion
equalLinesWith a -> [String]
toStringLines a
x a
y = String -> [String] -> [String] -> Assertion
forall a. (Ord a, IsText a) => String -> [a] -> [a] -> Assertion
checkLinesDiff String
"equalLinesWith" (a -> [String]
toStringLines a
x) (a -> [String]
toStringLines a
y)
checkLinesDiff :: (Ord a, IsText a) => String -> [a] -> [a] -> Assertion
checkLinesDiff :: String -> [a] -> [a] -> Assertion
checkLinesDiff String
label = [a] -> [a] -> Assertion
forall a. (IsText a, Ord a) => [a] -> [a] -> Assertion
go
where
go :: [a] -> [a] -> Assertion
go [a]
xs [a]
ys =
case [Item a] -> (Bool, String)
forall (t :: * -> *) a.
(Foldable t, IsText a) =>
t (Item a) -> (Bool, String)
checkItems ([a] -> [a] -> [Item a]
forall a. Ord a => [a] -> [a] -> [Item a]
Patience.diff [a]
xs [a]
ys) of
(Bool
same, String
diff) -> Bool -> String -> Assertion
assertBool Bool
same String
diff
checkItems :: t (Item a) -> (Bool, String)
checkItems t (Item a)
diffItems =
case ((Bool, [String]) -> Item a -> (Bool, [String]))
-> (Bool, [String]) -> t (Item a) -> (Bool, [String])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool, [String]) -> Item a -> (Bool, [String])
forall a.
IsText a =>
(Bool, [String]) -> Item a -> (Bool, [String])
checkItem (Bool
True, []) t (Item a)
diffItems of
(Bool
same, [String]
diff) -> (Bool
same, ShowS
errorMsg (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
diff)))
checkItem :: (Bool, [String]) -> Item a -> (Bool, [String])
checkItem (Bool
same, [String]
acc) Item a
item =
case Item a
item of
Patience.Old a
t -> (Bool
False, (String
"\t- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. IsText a => a -> String
unpack a
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc)
Patience.New a
t -> (Bool
False, (String
"\t+ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. IsText a => a -> String
unpack a
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc)
Patience.Both a
t a
_-> (Bool
same, (String
"\t " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. IsText a => a -> String
unpack a
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc)
errorMsg :: ShowS
errorMsg String
diff = String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": lines differ\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
diff