{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      : Test.Fluent.Assertions
-- Description : Set of combinators and primitives to use fluen assertions
-- Copyright   : (c) Pawel Nosal, 2021
-- License     : MIT
-- Maintainer  : p.nosal1986@gmail.com
-- Stability   : experimental
--
-- This library aims to provide a set of combinators to assert arbitrary nested data structures.
-- The inspiration of this library is AssertJ for Java, the composition of assertions was inspired by `lens` library.
--
-- Example:
--
-- @
--  data Foo = Foo {name :: String, age :: Int} deriving (Show, Eq)
--
--  assertThat (Foo "someName" 15) $
--       isEqualTo (Foo "someN1ame" 15)
--       . focus age
--       . tag "age"
--       . isGreaterThan 20
-- @
--
-- result in
--
-- @
--  given Foo {name = "someName", age = 15} should be equal to Foo {name = "someN1ame", age = 15}
--  Foo {name = "someName", age = 15}
--  ╷
--  │
--  ╵
--  Foo {name = "someN1ame", age = 15}
--                    ▲
--  [age] given 15 should be greater than 20
-- @
module Test.Fluent.Assertions
  ( -- * Assertions

    -- ** Basic assertions
    simpleAssertion,
    isEqualTo,
    isNotEqualTo,
    isGreaterThan,
    isGreaterEqualThan,
    isLowerThan,
    isLowerEqualThan,
    shouldSatisfy,
    hasSize,
    isEmpty,
    isNotEmpty,
    contains,

    -- ** Assertion util functions
    focus,
    inside,
    tag,
    forceError,

    -- ** Assertion configuration
    AssertionConfig,
    defaultConfig,
    setAssertionTimeout,

    -- * Types

    -- ** Assertion defitions
    Assertion,
    Assertion',

    -- ** Assertion failure
    FluentTestFailure (..),
  )
where

import Data.Functor.Contravariant (Contravariant (contramap))
import GHC.Stack (HasCallStack)
import Test.Fluent.Diff (pretty)
import Test.Fluent.Internal.AssertionConfig
  ( AssertionConfig,
    defaultConfig,
    setAssertionTimeout,
  )
import Test.Fluent.Internal.Assertions (Assertion, Assertion', AssertionDefinition (SequentialAssertions), FluentTestFailure (..), basicAssertion, transformAssertions, updateLabel)

-- | The 'simpleAssertion' function is a building block of more complicated assertions.
--
--  It takes one predicate and function to format error message.
--
-- @
--  myIsEqual x = simpleAssertion (== x) (\\x' -> show x' <> " is not equal to " <> show x)
-- @
simpleAssertion ::
  HasCallStack =>
  -- | A predicate that should be met by the subject under test
  (a -> Bool) ->
  -- | A function that allows formatting an error message once the predicate is not met
  (a -> String) ->
  Assertion a
simpleAssertion :: (a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion a -> Bool
predicate a -> String
formatter a -> AssertionDefinition a
f a
s = (a -> Bool)
-> (a -> String) -> AssertionDefinition a -> AssertionDefinition a
forall a.
HasCallStack =>
(a -> Bool)
-> (a -> String) -> AssertionDefinition a -> AssertionDefinition a
basicAssertion a -> Bool
predicate a -> String
formatter (a -> AssertionDefinition a
f a
s)

-- | assert if subject under test is equal to given value
--
-- @
--  assertThat 15 $ isEqualTo 16
-- @
--
-- result
--
-- @
--  given 15 should be equal to 16
--   ▼
--  15
--  ╷
--  │
--  ╵
--  16
--   ▲
-- @
isEqualTo :: (Eq a, Show a, HasCallStack) => a -> Assertion a
isEqualTo :: a -> Assertion a
isEqualTo a
a = (a -> Bool) -> (a -> String) -> Assertion a
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (Bool -> String -> a -> a -> String
forall a. Show a => Bool -> String -> a -> a -> String
formatMessage Bool
True String
"should be equal to" a
a)

isNotEqualTo :: (Eq a, Show a, HasCallStack) => a -> Assertion a
isNotEqualTo :: a -> Assertion a
isNotEqualTo a
a = (a -> Bool) -> (a -> String) -> Assertion a
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Bool -> String -> a -> a -> String
forall a. Show a => Bool -> String -> a -> a -> String
formatMessage Bool
False String
"should be not equal to" a
a)

-- | assert if the subject under test is greater than given value
--
-- @
--  assertThat 15 $ isGreaterThan 16
-- @
--
-- result
--
-- @
--  given 15 should be greater than 16
-- @
isGreaterThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a
isGreaterThan :: a -> Assertion a
isGreaterThan a
a = (a -> Bool) -> (a -> String) -> Assertion a
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<) (Bool -> String -> a -> a -> String
forall a. Show a => Bool -> String -> a -> a -> String
formatMessage Bool
False String
"should be greater than" a
a)

isGreaterEqualThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a
isGreaterEqualThan :: a -> Assertion a
isGreaterEqualThan a
a = (a -> Bool) -> (a -> String) -> Assertion a
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=) (Bool -> String -> a -> a -> String
forall a. Show a => Bool -> String -> a -> a -> String
formatMessage Bool
False String
"should be greater or equal to" a
a)

-- | assert if the subject under test is lower than given value
--
-- @
--  assertThat 16 $ isLowerThan 15
-- @
--
-- result
--
-- @
--  given 16 should be lower than 15
-- @
isLowerThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a
isLowerThan :: a -> Assertion a
isLowerThan a
a = (a -> Bool) -> (a -> String) -> Assertion a
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>) (Bool -> String -> a -> a -> String
forall a. Show a => Bool -> String -> a -> a -> String
formatMessage Bool
False String
"should be lower than" a
a)

isLowerEqualThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a
isLowerEqualThan :: a -> Assertion a
isLowerEqualThan a
a = (a -> Bool) -> (a -> String) -> Assertion a
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=) (Bool -> String -> a -> a -> String
forall a. Show a => Bool -> String -> a -> a -> String
formatMessage Bool
False String
"should be lower or equal to" a
a)

shouldSatisfy :: (Show a, HasCallStack) => (a -> Bool) -> Assertion a
shouldSatisfy :: (a -> Bool) -> Assertion a
shouldSatisfy a -> Bool
predicate = (a -> Bool) -> (a -> String) -> Assertion a
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion a -> Bool
predicate (String -> a -> String
forall a. Show a => String -> a -> String
formatMessage' String
"does not met a predicate")

hasSize :: (Foldable t, HasCallStack) => Int -> Assertion (t a)
hasSize :: Int -> Assertion (t a)
hasSize Int
expectedSize = (t a -> Int) -> Assertion Int -> Assertion (t a)
forall b a. (b -> a) -> Assertion a -> Assertion b
inside t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> Bool) -> (Int -> String) -> Assertion Int
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedSize) Int -> String
forall a. Show a => a -> String
assertionMessage)
  where
    assertionMessage :: a -> String
assertionMessage a
currentSize = String
"expected size " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
expectedSize String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not equal actual size " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
currentSize

isEmpty :: (Foldable t, HasCallStack) => Assertion (t a)
isEmpty :: Assertion (t a)
isEmpty = (t a -> Bool) -> Assertion Bool -> Assertion (t a)
forall b a. (b -> a) -> Assertion a -> Assertion b
inside t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Bool -> Bool) -> (Bool -> String) -> Assertion Bool
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) Bool -> String
forall p p. IsString p => p -> p
assertionMessage)
  where
    assertionMessage :: p -> p
assertionMessage p
_ = p
"should be empty, but is not"

isNotEmpty :: (Foldable t, HasCallStack) => Assertion (t a)
isNotEmpty :: Assertion (t a)
isNotEmpty = (t a -> Bool) -> Assertion Bool -> Assertion (t a)
forall b a. (b -> a) -> Assertion a -> Assertion b
inside t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Bool -> Bool) -> (Bool -> String) -> Assertion Bool
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) Bool -> String
forall p p. IsString p => p -> p
assertionMessage)
  where
    assertionMessage :: p -> p
assertionMessage p
_ = p
"should be not empty"

contains :: (Foldable t, Eq a, Show a, HasCallStack) => a -> Assertion (t a)
contains :: a -> Assertion (t a)
contains a
expectedElem = (t a -> Bool) -> Assertion Bool -> Assertion (t a)
forall b a. (b -> a) -> Assertion a -> Assertion b
inside (a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
expectedElem) ((Bool -> Bool) -> (Bool -> String) -> Assertion Bool
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) Bool -> String
forall p. p -> String
assertionMessage)
  where
    assertionMessage :: p -> String
assertionMessage p
_ = String
"should contain element " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
expectedElem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", but it doesn't"

-- | allow changing subject under test using a transformation function
--
-- @
--  assertThat "1    " $
--            isNotEqualTo ""
--              . focus length
--              . isEqualTo 10
-- @
--
-- result
--
-- @
--  given 5 should be equal to 10
--  ▼
--  5
--  ╷
--  │
--  ╵
--  10
--  ▲▲
-- @
focus :: (a -> b) -> Assertion' a b
focus :: (a -> b) -> Assertion' a b
focus a -> b
f b -> AssertionDefinition b
assert a
s = (a -> b) -> AssertionDefinition b -> AssertionDefinition a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f (b -> AssertionDefinition b
assert (a -> b
f a
s))

-- |  like 'focus', this function allow changing subject under test, it takes an assertion for modified value, then it allows us to continue assertion on the original value
--
-- @
--   assertThat (Foo "someName" 15) $
--                 isEqualTo (Foo "someN1ame" 15)
--               . inside age (tag "age" . isGreaterThan 20 . isLowerThan 10)
--               . isEqualTo (Foo "someName" 15)
-- @
--
-- result
--
-- @
--  given Foo {name = "someName", age = 15} should be equal to Foo {name = "someN1ame", age = 15}
--        Foo {name = "someName", age = 15}
--        ╷
--        │
--        ╵
--        Foo {name = "someN1ame", age = 15}
--                          ▲
--        [age] given 15 should be greater than 20
--        [age] given 15 should be lower than 10
-- @
inside :: (b -> a) -> Assertion a -> Assertion b
inside :: (b -> a) -> Assertion a -> Assertion b
inside b -> a
f Assertion a
assert' b -> AssertionDefinition b
b b
s = b -> AssertionDefinition b
b b
s AssertionDefinition b
-> AssertionDefinition b -> AssertionDefinition b
forall a. Semigroup a => a -> a -> a
<> [AssertionDefinition b] -> AssertionDefinition b
forall a. Monoid a => [a] -> a
mconcat ([AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
forall a b.
[AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions [Assertion a
assert' a -> AssertionDefinition a
forall a. Monoid a => a
mempty (b -> a
f b
s)] b -> a
f)

-- |  this combinator allows marking following assertion with a given prefix
--
-- @
-- assertThat (Foo "someName" 15) $
--   tag "foo" . isEqualTo (Foo "someN1ame" 15)
--     . inside age (tag "age" . isGreaterThan 20 . isLowerThan 10)
--     . tag "foo not equal"
--     . isNotEqualTo (Foo "someName" 15)
-- @
--
-- result
--
-- @
--  [foo] given Foo {name = "someName", age = 15} should be equal to Foo {name = "someN1ame", age = 15}
--  Foo {name = "someName", age = 15}
--  ╷
--  │
--  ╵
--  Foo {name = "someN1ame", age = 15}
--                    ▲
--  [foo.age] given 15 should be greater than 20
--  [foo.age] given 15 should be lower than 10
--  [foo.not equal to] given Foo {name = "someName", age = 15} should be not equal to Foo {name = "someName", age = 15}
--  Foo {name = "someName", age = 15}
--  ╷
--  │
--  ╵
--  Foo {name = "someName", age = 15}
-- @
tag :: String -> Assertion a
tag :: String -> Assertion a
tag String
label a -> AssertionDefinition a
assert a
s = String -> AssertionDefinition a -> AssertionDefinition a
forall a. String -> AssertionDefinition a -> AssertionDefinition a
updateLabel String
label (a -> AssertionDefinition a
assert a
s)

-- |  Sometimes it is handy to stop the assertions chain.
--
--    This combinator gets an assertion that should be forced, any following assertion will be not executed then
--
-- @
-- extracting :: HasCallStack => Assertion' (Maybe a) a
-- extracting = forceError isJust . focus Maybe.fromJust
-- @
forceError :: Assertion a -> Assertion a
forceError :: Assertion a -> Assertion a
forceError Assertion a
assert' a -> AssertionDefinition a
b a
s = [AssertionDefinition a] -> AssertionDefinition a
forall a. [AssertionDefinition a] -> AssertionDefinition a
SequentialAssertions [a -> AssertionDefinition a
b a
s] AssertionDefinition a
-> AssertionDefinition a -> AssertionDefinition a
forall a. Semigroup a => a -> a -> a
<> [AssertionDefinition a] -> AssertionDefinition a
forall a. Monoid a => [a] -> a
mconcat ([AssertionDefinition a] -> (a -> a) -> [AssertionDefinition a]
forall a b.
[AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]
transformAssertions [Assertion a
assert' a -> AssertionDefinition a
forall a. Monoid a => a
mempty a
s] a -> a
forall a. a -> a
id)

formatMessage :: Show a => Bool -> String -> a -> a -> String
formatMessage :: Bool -> String -> a -> a -> String
formatMessage Bool
True String
message a
a a
a' = String
"given " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> a -> String
forall a. Show a => a -> a -> String
pretty a
a' a
a
formatMessage Bool
False String
message a
a a
a' = String
"given " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a

formatMessage' :: Show a => String -> a -> String
formatMessage' :: String -> a -> String
formatMessage' String
message a
a = String
"given " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message