{-# LANGUAGE TemplateHaskell #-}

-- | Chell is a simple and intuitive library for automated testing. It natively
-- supports assertion-based testing, and can use companion libraries
-- such as @chell-quickcheck@ to support more complex testing strategies.
--
-- An example test suite, which verifies the behavior of arithmetic operators.
--
-- @
-- {-\# LANGUAGE TemplateHaskell \#-}
--
-- import Test.Chell
--
-- suite_Math :: Suite
-- suite_Math = 'suite' \"math\"
--    [ test_Addition
--    , test_Subtraction
--    ]
--
-- test_Addition :: Test
-- test_Addition = 'assertions' \"addition\" $ do
--    $'expect' ('equal' (2 + 1) 3)
--    $'expect' ('equal' (1 + 2) 3)
--
-- test_Subtraction :: Test
-- test_Subtraction = 'assertions' \"subtraction\" $ do
--    $'expect' ('equal' (2 - 1) 1)
--    $'expect' ('equal' (1 - 2) (-1))
--
-- main :: IO ()
-- main = 'defaultMain' [suite_Math]
-- @
--
-- >$ ghc --make chell-example.hs
-- >$ ./chell-example
-- >PASS: 2 tests run, 2 tests passed
module Test.Chell
  ( -- * Main
    defaultMain,

    -- * Test suites
    Suite,
    suite,
    suiteName,
    suiteTests,

    -- ** Skipping some tests
    SuiteOrTest,
    skipIf,
    skipWhen,

    -- * Basic testing library
    Assertions,
    assertions,
    IsAssertion,
    Assertion,
    assertionPassed,
    assertionFailed,
    assert,
    expect,
    die,
    trace,
    note,
    afterTest,
    requireLeft,
    requireRight,

    -- ** Built-in assertions
    equal,
    notEqual,
    equalWithin,
    just,
    nothing,
    left,
    right,
    throws,
    throwsEq,
    greater,
    greaterEqual,
    lesser,
    lesserEqual,
    sameItems,
    equalItems,
    IsText,
    equalLines,
    equalLinesWith,

    -- * Custom test types
    Test,
    test,
    testName,
    runTest,

    -- ** Test results
    TestResult (..),

    -- *** Failures
    Failure,
    failure,
    failureLocation,
    failureMessage,

    -- *** Failure locations
    Location,
    location,
    locationFile,
    locationModule,
    locationLine,

    -- ** Test options
    TestOptions,
    defaultTestOptions,
    testOptionSeed,
    testOptionTimeout,
  )
where

import Control.Applicative qualified
import Control.Exception (Exception)
import Control.Exception qualified
import Control.Monad (ap, liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString.Char8 qualified
import Data.ByteString.Lazy.Char8 qualified
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
import Data.List (foldl', intercalate, sort)
import Data.Maybe (isJust, isNothing)
import Data.Text (Text)
import Data.Text qualified
import Data.Text.Lazy qualified
import Language.Haskell.TH qualified as TH
import Patience qualified
import Test.Chell.Main (defaultMain)
import Test.Chell.Types

-- | A single pass/fail assertion. Failed assertions include an explanatory
-- message.
data Assertion
  = AssertionPassed
  | AssertionFailed String
  deriving (Assertion -> Assertion -> Bool
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
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)

-- | See 'Assertion'.
assertionPassed :: Assertion
assertionPassed :: Assertion
assertionPassed = Assertion
AssertionPassed

-- | See 'Assertion'.
assertionFailed :: String -> Assertion
assertionFailed :: String -> Assertion
assertionFailed = String -> Assertion
AssertionFailed

-- | See 'assert' and 'expect'.
class IsAssertion a where
  runAssertion :: a -> IO Assertion

instance IsAssertion Assertion where
  runAssertion :: Assertion -> IO Assertion
runAssertion = forall (m :: * -> *) a. Monad m => a -> m a
return

instance IsAssertion Bool where
  runAssertion :: Bool -> IO Assertion
runAssertion Bool
x =
    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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IsAssertion a => a -> IO Assertion
runAssertion

type TestState = (IORef [(String, String)], IORef [IO ()], [Failure])

-- | See 'assertions'.
newtype Assertions a = Assertions
  {forall a. Assertions a -> TestState -> IO (Maybe a, TestState)
unAssertions :: TestState -> IO (Maybe a, TestState)}

instance Functor Assertions where
  fmap :: forall a b. (a -> b) -> Assertions a -> Assertions b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Control.Applicative.Applicative Assertions where
  pure :: forall a. a -> Assertions a
pure a
x = forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions (\TestState
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
x, TestState
s))
  <*> :: forall a 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
  Assertions a
m >>= :: forall a b. Assertions a -> (a -> Assertions b) -> Assertions b
>>= a -> Assertions b
f =
    forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions
      ( \TestState
s ->
          do
            (Maybe a
maybe_a, TestState
s') <- forall a. Assertions a -> TestState -> IO (Maybe a, TestState)
unAssertions Assertions a
m TestState
s
            case Maybe a
maybe_a of
              Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, TestState
s')
              Just a
a -> forall a. Assertions a -> TestState -> IO (Maybe a, TestState)
unAssertions (a -> Assertions b
f a
a) TestState
s'
      )

instance MonadIO Assertions where
  liftIO :: forall a. IO a -> Assertions a
liftIO IO a
io =
    forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions
      ( \TestState
s ->
          do
            a
x <- IO a
io
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x, TestState
s)
      )

-- | Convert a sequence of pass/fail assertions into a runnable test.
--
-- @
-- test_Equality :: Test
-- test_Equality = assertions \"equality\" $ do
--     $assert (1 == 1)
--     $assert (equal 1 1)
-- @
assertions :: String -> Assertions a -> Test
assertions :: forall a. String -> Assertions a -> Test
assertions String
name Assertions a
testm =
  String -> (TestOptions -> IO TestResult) -> Test
test String
name forall a b. (a -> b) -> a -> b
$ \TestOptions
opts ->
    do
      IORef [(String, String)]
noteRef <- forall a. a -> IO (IORef a)
newIORef []
      IORef [IO ()]
afterTestRef <- forall a. a -> IO (IORef a)
newIORef []

      let getNotes :: IO [(String, String)]
getNotes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse (forall a. IORef a -> IO a
readIORef IORef [(String, String)]
noteRef)

      let getResult :: IO TestResult
getResult =
            do
              (Maybe a, TestState)
res <- 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
                    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
                    forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)] -> [Failure] -> TestResult
TestFailed [(String, String)]
notes (forall a. [a] -> [a]
reverse [Failure]
fs))

      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 = forall a. IORef a -> IO a
readIORef IORef [IO ()]
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b}. [IO b] -> IO ()
loop
  where
    loop :: [IO b] -> IO ()
loop [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop (IO b
io : [IO b]
ios) = 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 =
  forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
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
              forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. a -> Maybe a
Just (forall a. Integral a => a -> Integer
toInteger (forall a b. (a, b) -> a
fst (Loc -> CharPos
TH.loc_start Loc
th_loc)))
                  }
      let f :: Failure
f =
            Failure
failure
              { failureLocation :: Maybe Location
failureLocation = Maybe Location
loc,
                failureMessage :: String
failureMessage = String
msg
              }
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (), (IORef [(String, String)]
notes, IORef [IO ()]
afterTestRef, Failure
f forall a. a -> [a] -> [a]
: [Failure]
fs))

-- | Cause a test to immediately fail, with a message.
--
-- 'die' is a Template Haskell macro, to retain the source-file location from
-- which it was used. Its effective type is:
--
-- @

-- $die :: 'String' -> 'Assertions' a
-- @

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 :: forall a. Loc -> String -> Assertions a
dieAt Loc
loc String
msg =
  do
    Maybe Loc -> String -> Assertions ()
addFailure (forall a. a -> Maybe a
Just Loc
loc) String
msg
    forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions (\TestState
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, TestState
s))

-- | Print a message from within a test. This is just a helper for debugging,
-- so you don't have to import @Debug.Trace@. Messages will be prefixed with
-- the filename and line number where @$trace@ was called.
--
-- 'trace' is a Template Haskell macro, to retain the source-file location
-- from which it was used. Its effective type is:
--
-- @

-- $trace :: 'String' -> 'Assertions' ()
-- @

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 =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    do
      let file :: String
file = Loc -> String
TH.loc_filename Loc
loc
          line :: Int
line = forall a b. (a, b) -> a
fst (Loc -> CharPos
TH.loc_start Loc
loc)
      String -> IO ()
putStr (String
"[" forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
line forall a. [a] -> [a] -> [a]
++ String
"] ")
      String -> IO ()
putStrLn String
msg

-- | Attach a note to a test run. Notes will be printed to stdout and
-- included in reports, even if the test fails or aborts. Notes are useful for
-- debugging failing tests.
note :: String -> String -> Assertions ()
note :: String -> String -> Assertions ()
note String
key String
value =
  forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions
    ( \(IORef [(String, String)]
notes, IORef [IO ()]
afterTestRef, [Failure]
fs) ->
        do
          forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(String, String)]
notes ((String
key, String
value) :)
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (), (IORef [(String, String)]
notes, IORef [IO ()]
afterTestRef, [Failure]
fs))
    )

-- | Register an IO action to be run after the test completes. This action
-- will run even if the test failed or aborted.
afterTest :: IO () -> Assertions ()
afterTest :: IO () -> Assertions ()
afterTest IO ()
io =
  forall a. (TestState -> IO (Maybe a, TestState)) -> Assertions a
Assertions
    ( \(IORef [(String, String)]
notes, IORef [IO ()]
ref, [Failure]
fs) ->
        do
          forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [IO ()]
ref (IO ()
io :)
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (), (IORef [(String, String)]
notes, IORef [IO ()]
ref, [Failure]
fs))
    )

-- | Require an 'Either' value to be 'Left', and return its contents. If
-- the value is 'Right', fail the test.
--
-- 'requireLeft' is a Template Haskell macro, to retain the source-file
-- location from which it was used. Its effective type is:
--
-- @

-- $requireLeft :: 'Show' b => 'Either' a b -> 'Assertions' a
-- @

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 :: forall b a. Show b => Loc -> Either a b -> Assertions a
requireLeftAt Loc
loc Either a b
val =
  case Either a b
val of
    Left a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Right b
b ->
      do
        let dummy :: Either () b
dummy = forall a b. b -> Either a b
Right b
b forall a. a -> a -> a
`asTypeOf` forall a b. a -> Either a b
Left ()
        forall a. Loc -> String -> Assertions a
dieAt Loc
loc (String
"requireLeft: received " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either () b
dummy String
"")

-- | Require an 'Either' value to be 'Right', and return its contents. If
-- the value is 'Left', fail the test.
--
-- 'requireRight' is a Template Haskell macro, to retain the source-file
-- location from which it was used. Its effective type is:
--
-- @

-- $requireRight :: 'Show' a => 'Either' a b -> 'Assertions' b
-- @

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 :: forall a b. Show a => 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 = forall a b. a -> Either a b
Left a
a forall a. a -> a -> a
`asTypeOf` forall a b. b -> Either a b
Right ()
        forall a. Loc -> String -> Assertions a
dieAt Loc
loc (String
"requireRight: received " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either a ()
dummy String
"")
    Right b
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 :: CharPos
start = Loc -> CharPos
TH.loc_start Loc
loc
    end :: CharPos
end = Loc -> CharPos
TH.loc_end Loc
loc

assertAt :: IsAssertion assertion => TH.Loc -> Bool -> assertion -> Assertions ()
assertAt :: forall assertion.
IsAssertion assertion =>
Loc -> Bool -> assertion -> Assertions ()
assertAt Loc
loc Bool
fatal assertion
assertion =
  do
    Assertion
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IsAssertion a => a -> IO Assertion
runAssertion assertion
assertion)
    case Assertion
result of
      Assertion
AssertionPassed -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      AssertionFailed String
err ->
        if Bool
fatal
          then forall a. Loc -> String -> Assertions a
dieAt Loc
loc String
err
          else Maybe Loc -> String -> Assertions ()
addFailure (forall a. a -> Maybe a
Just Loc
loc) String
err

-- | Check an assertion. If the assertion fails, the test will immediately
-- fail.
--
-- The assertion to check can be a boolean value, an 'Assertion', or an IO
-- action returning one of the above.
--
-- 'assert' is a Template Haskell macro, to retain the source-file location
-- from which it was used. Its effective type is:
--
-- @

-- $assert :: 'IsAssertion' assertion => assertion -> 'Assertions' ()
-- @

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|]

-- | Check an assertion. If the assertion fails, the test will continue to
-- run until it finishes, a call to 'assert' fails, or the test runs 'die'.
--
-- The assertion to check can be a boolean value, an 'Assertion', or an IO
-- action returning one of the above.
--
-- 'expect' is a Template Haskell macro, to retain the source-file location
-- from which it was used. Its effective type is:
--
-- @

-- $expect :: 'IsAssertion' assertion => assertion -> 'Assertions' ()
-- @

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

-- | Assert that two values are equal.
equal :: (Show a, Eq a) => a -> a -> Assertion
equal :: forall a. (Show a, Eq a) => a -> a -> Assertion
equal a
x a
y =
  Bool -> String -> Assertion
assertBool
    (a
x forall a. Eq a => a -> a -> Bool
== a
y)
    (String
"equal: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
" is not equal to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y)

-- | Assert that two values are not equal.
notEqual :: (Eq a, Show a) => a -> a -> Assertion
notEqual :: forall a. (Eq a, Show a) => a -> a -> Assertion
notEqual a
x a
y =
  Bool -> String -> Assertion
assertBool
    (a
x forall a. Eq a => a -> a -> Bool
/= a
y)
    (String
"notEqual: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
" is equal to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y)

-- | Assert that two values are within some delta of each other.
equalWithin ::
  (Real a, Show a) =>
  a ->
  a ->
  -- | delta
  a ->
  Assertion
equalWithin :: forall a. (Real a, Show a) => a -> a -> a -> Assertion
equalWithin a
x a
y a
delta =
  Bool -> String -> Assertion
assertBool
    ((a
x forall a. Num a => a -> a -> a
- a
delta forall a. Ord a => a -> a -> Bool
<= a
y) Bool -> Bool -> Bool
&& (a
x forall a. Num a => a -> a -> a
+ a
delta forall a. Ord a => a -> a -> Bool
>= a
y))
    (String
"equalWithin: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
" is not within " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
delta forall a. [a] -> [a] -> [a]
++ String
" of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y)

-- | Assert that some value is @Just@.
just :: Maybe a -> Assertion
just :: forall a. Maybe a -> Assertion
just Maybe a
x = Bool -> String -> Assertion
assertBool (forall a. Maybe a -> Bool
isJust Maybe a
x) (String
"just: received Nothing")

-- | Assert that some value is @Nothing@.
nothing :: Show a => Maybe a -> Assertion
nothing :: forall a. Show a => Maybe a -> Assertion
nothing Maybe a
x =
  Bool -> String -> Assertion
assertBool
    (forall a. Maybe a -> Bool
isNothing Maybe a
x)
    (String
"nothing: received " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe a
x String
"")

-- | Assert that some value is @Left@.
left :: Show b => Either a b -> Assertion
left :: forall b a. Show b => Either a b -> Assertion
left (Left a
_) = Assertion
assertionPassed
left (Right b
b) = String -> Assertion
assertionFailed (String
"left: received " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either () b
dummy String
"")
  where
    dummy :: Either () b
dummy = forall a b. b -> Either a b
Right b
b forall a. a -> a -> a
`asTypeOf` forall a b. a -> Either a b
Left ()

-- | Assert that some value is @Right@.
right :: Show a => Either a b -> Assertion
right :: forall a b. Show a => Either a b -> Assertion
right (Right b
_) = Assertion
assertionPassed
right (Left a
a) = String -> Assertion
assertionFailed (String
"right: received " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Either a ()
dummy String
"")
  where
    dummy :: Either a ()
dummy = forall a b. a -> Either a b
Left a
a forall a. a -> a -> a
`asTypeOf` forall a b. b -> Either a b
Right ()

-- | Assert that some computation throws an exception matching the provided
-- predicate. This is mostly useful for exception types which do not have an
-- instance for @Eq@, such as @'Control.Exception.ErrorCall'@.
throws :: Exception err => (err -> Bool) -> IO a -> IO Assertion
throws :: forall err a.
Exception err =>
(err -> Bool) -> IO a -> IO Assertion
throws err -> Bool
p IO a
io =
  do
    Either err a
either_exc <- forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try IO a
io
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 "
                    forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show err
exc
                    forall a. [a] -> [a] -> [a]
++ String
" did not match predicate"
                )
        Right a
_ -> String -> Assertion
assertionFailed String
"throws: no exception thrown"

-- | Assert that some computation throws an exception equal to the given
-- exception. This is better than just checking that the correct type was
-- thrown, because the test can also verify the exception contains the correct
-- information.
throwsEq :: (Eq err, Exception err, Show err) => err -> IO a -> IO Assertion
throwsEq :: forall err a.
(Eq err, Exception err, Show err) =>
err -> IO a -> IO Assertion
throwsEq err
expected IO a
io =
  do
    Either err a
either_exc <- forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try IO a
io
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      case Either err a
either_exc of
        Left err
exc ->
          if err
exc forall a. Eq a => a -> a -> Bool
== err
expected
            then Assertion
assertionPassed
            else
              String -> Assertion
assertionFailed
                ( String
"throwsEq: exception "
                    forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show err
exc
                    forall a. [a] -> [a] -> [a]
++ String
" is not equal to "
                    forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show err
expected
                )
        Right a
_ -> String -> Assertion
assertionFailed String
"throwsEq: no exception thrown"

-- | Assert a value is greater than another.
greater :: (Ord a, Show a) => a -> a -> Assertion
greater :: forall a. (Ord a, Show a) => a -> a -> Assertion
greater a
x a
y =
  Bool -> String -> Assertion
assertBool
    (a
x forall a. Ord a => a -> a -> Bool
> a
y)
    (String
"greater: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
" is not greater than " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y)

-- | Assert a value is greater than or equal to another.
greaterEqual :: (Ord a, Show a) => a -> a -> Assertion
greaterEqual :: forall a. (Ord a, Show a) => a -> a -> Assertion
greaterEqual a
x a
y =
  Bool -> String -> Assertion
assertBool
    (a
x forall a. Ord a => a -> a -> Bool
>= a
y)
    (String
"greaterEqual: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
" is not greater than or equal to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y)

-- | Assert a value is less than another.
lesser :: (Ord a, Show a) => a -> a -> Assertion
lesser :: forall a. (Ord a, Show a) => a -> a -> Assertion
lesser a
x a
y =
  Bool -> String -> Assertion
assertBool
    (a
x forall a. Ord a => a -> a -> Bool
< a
y)
    (String
"lesser: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
" is not less than " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y)

-- | Assert a value is less than or equal to another.
lesserEqual :: (Ord a, Show a) => a -> a -> Assertion
lesserEqual :: forall a. (Ord a, Show a) => a -> a -> Assertion
lesserEqual a
x a
y =
  Bool -> String -> Assertion
assertBool
    (a
x forall a. Ord a => a -> a -> Bool
<= a
y)
    (String
"lesserEqual: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
" is not less than or equal to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y)

-- | Assert that two containers have the same items, in any order.
sameItems ::
  (Foldable container, Show item, Ord item) =>
  container item ->
  container item ->
  Assertion
sameItems :: forall (container :: * -> *) item.
(Foldable container, Show item, Ord item) =>
container item -> container item -> Assertion
sameItems container item
x container item
y = forall (container :: * -> *) item.
(Foldable container, Show item, Ord item) =>
String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
equalDiff' String
"sameItems" forall a. Ord a => [a] -> [a]
sort container item
x container item
y

-- | Assert that two containers have the same items, in the same order.
equalItems ::
  (Foldable container, Show item, Ord item) =>
  container item ->
  container item ->
  Assertion
equalItems :: forall (container :: * -> *) item.
(Foldable container, Show item, Ord item) =>
container item -> container item -> Assertion
equalItems container item
x container item
y = forall (container :: * -> *) item.
(Foldable container, Show item, Ord item) =>
String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
equalDiff' String
"equalItems" 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' :: forall (container :: * -> *) item.
(Foldable container, Show item, Ord item) =>
String
-> ([item] -> [item])
-> container item
-> container item
-> Assertion
equalDiff' String
label [item] -> [item]
norm container item
x container item
y = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> [a] -> [a]
: [])
    checkDiff :: [a] -> [a] -> Assertion
checkDiff [a]
xs [a]
ys =
      case forall {t :: * -> *} {a}.
(Foldable t, Show a) =>
t (Item a) -> (Bool, String)
checkItems (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 forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 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 (forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (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- " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
t) forall a. a -> [a] -> [a]
: [String]
acc)
        Patience.New a
t -> (Bool
False, (String
"\t+ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
t) forall a. a -> [a] -> [a]
: [String]
acc)
        Patience.Both a
t a
_ -> (Bool
same, (String
"\t  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
t) forall a. a -> [a] -> [a]
: [String]
acc)

    errorMsg :: ShowS
errorMsg String
diff = String
label forall a. [a] -> [a] -> [a]
++ String
": items differ\n" forall a. [a] -> [a] -> [a]
++ String
diff

-- | Class for types which can be treated as text; see 'equalLines'.
class IsText a where
  toLines :: a -> [a]
  unpack :: a -> String

instance IsText String where
  toLines :: String -> [String]
toLines = String -> [String]
lines
  unpack :: ShowS
unpack = 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

-- | Uses @Data.ByteString.Char8@
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

-- | Uses @Data.ByteString.Lazy.Char8@
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

-- | Assert that two pieces of text are equal. This uses a diff algorithm
-- to check line-by-line, so the error message will be easier to read on
-- large inputs.
equalLines :: (Ord a, IsText a) => a -> a -> Assertion
equalLines :: forall a. (Ord a, IsText a) => a -> a -> Assertion
equalLines a
x a
y = forall a. (Ord a, IsText a) => String -> [a] -> [a] -> Assertion
checkLinesDiff String
"equalLines" (forall a. IsText a => a -> [a]
toLines a
x) (forall a. IsText a => a -> [a]
toLines a
y)

-- | Variant of 'equalLines' which allows a user-specified line-splitting
-- predicate.
equalLinesWith :: Ord a => (a -> [String]) -> a -> a -> Assertion
equalLinesWith :: forall a. Ord a => (a -> [String]) -> a -> a -> Assertion
equalLinesWith a -> [String]
toStringLines a
x a
y = 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 :: forall a. (Ord a, IsText a) => String -> [a] -> [a] -> Assertion
checkLinesDiff String
label = forall {a}. (IsText a, Ord a) => [a] -> [a] -> Assertion
go
  where
    go :: [a] -> [a] -> Assertion
go [a]
xs [a]
ys =
      case forall {t :: * -> *} {a}.
(Foldable t, IsText a) =>
t (Item a) -> (Bool, String)
checkItems (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 forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 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 (forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (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- " forall a. [a] -> [a] -> [a]
++ forall a. IsText a => a -> String
unpack a
t) forall a. a -> [a] -> [a]
: [String]
acc)
        Patience.New a
t -> (Bool
False, (String
"\t+ " forall a. [a] -> [a] -> [a]
++ forall a. IsText a => a -> String
unpack a
t) forall a. a -> [a] -> [a]
: [String]
acc)
        Patience.Both a
t a
_ -> (Bool
same, (String
"\t  " forall a. [a] -> [a] -> [a]
++ forall a. IsText a => a -> String
unpack a
t) forall a. a -> [a] -> [a]
: [String]
acc)

    errorMsg :: ShowS
errorMsg String
diff = String
label forall a. [a] -> [a] -> [a]
++ String
": lines differ\n" forall a. [a] -> [a] -> [a]
++ String
diff