packages feed

assert4hs-core (empty) → 0.1.0

raw patch · 19 files changed

+1470/−0 lines, 19 filesdep +assert4hs-coredep +basedep +data-defaultsetup-changed

Dependencies added: assert4hs-core, base, data-default, hspec, hspec-discover, pretty-diff, text

Files

+ ChangeLog.md view
@@ -0,0 +1,15 @@+# Changelog for assert4hs++## 0.1.0++- Initial release+- Assertions for `Either` type+- Assertions for `Maybe` type+- Assertions for `List` type+- Assertions for `Exceptions`+- Basic assertions for `Foldable` types+- Implementation of core assertions+- assertion over infinitive data structure or not terminating predicates do not hang all test and timeout is reported+- the timeout for assertion is configurable now++## Unreleased changes
+ LICENSE.md view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Pawel Nosal++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,151 @@+# assert4hs++ 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.++ New assertions can be easily written and composed with other assertions. All failed assertions are gathered and presented to the user.++```haskell+  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++```haskell+  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+```++#### Examples++##### Simple assertion++```haskell+  result = 10+  assertThat result $ isEqual 10+```++##### Composing assertion++ Assertions are composable, this allows verifying multiple conditions during one test case.++```haskell+  result = 10+  assertThat result $ +      isGreaterThan 5 +      . isLowerThan 20+ + + >>> given 4 should be greater than 5+```++##### Focusing on part of data structure++ Sometimes it is convenient to transform the subject under test and execute assertions on the extracted part of it. For this purpose, we have a `focus` function.++```haskell+  data Foo = Foo {name :: String, age :: Int} deriving (Show, Eq)++  assertThat (Foo "someName" 15) $+      isEqualTo (Foo "someName" 15)+      . focus age+      . isGreaterThan 20+      . isLowerEqualThan 5++  >>> given 15 should be greater than 20 +  >>> given 15 should be lower or equal to 5+```++##### Changing subject uder test++The `focus` function allows to transform the subject under test, but the original subject is lost. Function `inside` is similar to the function `focus`, but preserve theoriginal subject under test.++```haskell+data Foo = Foo {name :: String, age :: Int} deriving (Show, Eq)++assertThat (Foo "someName" 15) $+    inside age (isGreaterThan 20 . isLowerEqualThan 5)+    . focus name +    . isEqualTo "someName1" ++>>> given 15 should be greater than 20+>>> +>>> given 15 should be lower or equal to 5+>>> +>>> given "someName" should be equal to "someName1"+>>> "someName"+>>> ╷+>>> │+>>> ╵+>>> "someName1"+>>>          ▲+```++##### Tagging assertions++Once our test grows, it is hard to spot which assertions failed and why. That is why function `tag` exists, one can name assertion and give it a more readable name for failure message.++```haskell++data Foo = Foo {name :: String, age :: Int} deriving (Show, Eq)++assertThat (Foo "someName" 15) $+  inside age (tag "age" . isGreaterThan 20 . isLowerEqualThan 5)+    . tag "name"+    . focus name+    . isEqualTo "someName1"+    . tag "should not be equal"+    . isNotEqualTo "someName"++>>> [age] given 15 should be greater than 20+>>> +>>> [age] given 15 should be lower or equal to 5+>>> +>>> [name] given "someName" should be equal to "someName1"+>>> "someName"+>>> ╷+>>> │+>>> ╵+>>> "someName1"+>>>          ▲+>>> +>>> [name.should not be equal] given "someName" should be not equal to "someName"+```++##### Custom assertions++ It is sometimes convenient to create a custom assertion which explicitly describes what is testing. For this purpose we have `simpleAssertion` function++```haskell+isSuitableForEmployment :: Assertion Foo+isSuitableForEmployment =+    simpleAssertion (\a -> age a > 17) (\a -> "new employee must be 18 years or older, but it has " <> show (age a))+    . simpleAssertion (\a -> age a < 70) (\a -> "must be younger than 70 years old, but it has " <> show (age a))++assertThat (Foo "someName" 15) isSuitableForEmployment++>>> new employee must be 18 years or older, but it has 15++assertThat (Foo "someName" 76) isSuitableForEmployment++>>> must be younger than 70 years old, but it has 76++```++#### Related projects++[assert4hs-hspec](https://github.com/paweln1986/assert4hs-hspec) - integration point of assert4hs and [hspec](https://hackage.haskell.org/package/hspec)++[assert4hs-tasty](https://github.com/paweln1986/assert4hs-tasty) - integration point of assert4hs and [tasty](https://hackage.haskell.org/package/tasty)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ assert4hs-core.cabal view
@@ -0,0 +1,78 @@+cabal-version:      1.12+name:               assert4hs-core+version:            0.1.0+license:            MIT+license-file:       LICENSE.md+copyright:          2021 Pawel Nosal+maintainer:         p.nosal1986@gmail.com+author:             Pawel Nosal+homepage:           https://github.com/paweln1986/assert4hs-core#readme+bug-reports:        https://github.com/paweln1986/assert4hs-core/issues+synopsis:           A set of assertion for writing more readable tests cases+description:+    Please see the README on GitHub at <https://github.com/paweln1986/assert4hs#readme>++category:           Testing+build-type:         Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+    type:     git+    location: https://github.com/paweln1986/assert4hs-core++library+    exposed-modules:+        Test.Fluent.Assertions+        Test.Fluent.Assertions.Core+        Test.Fluent.Assertions.Either+        Test.Fluent.Assertions.Exceptions+        Test.Fluent.Assertions.List+        Test.Fluent.Assertions.Maybe+        Test.Fluent.Diff+        Test.Fluent.Internal.AssertionConfig+        Test.Fluent.Internal.Assertions++    hs-source-dirs:     src+    other-modules:      Paths_assert4hs_core+    default-language:   Haskell2010+    default-extensions: OverloadedStrings BangPatterns+    ghc-options:+        -haddock -Wall -Wcompat -Wincomplete-record-updates+        -Wincomplete-uni-patterns -Wredundant-constraints+        -Wno-unused-do-bind -Werror=incomplete-patterns++    build-depends:+        base >=4.7 && <5,+        data-default >=0.7.1.1,+        pretty-diff >=0.4.0.0,+        text >=1.2.4.1++test-suite assert4hs-core-test+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    hs-source-dirs:     test+    other-modules:+        Assertions.ListsSpec+        Assertions.MaybeSpec+        AssertionSpecUtils+        AssertionsSpec+        Paths_assert4hs_core++    default-language:   Haskell2010+    default-extensions: OverloadedStrings BangPatterns+    ghc-options:+        -haddock -Wall -Wcompat -Wincomplete-record-updates+        -Wincomplete-uni-patterns -Wredundant-constraints+        -Wno-unused-do-bind -Werror=incomplete-patterns -threaded -rtsopts+        -with-rtsopts=-N++    build-depends:+        assert4hs-core -any,+        base >=4.7 && <5,+        data-default >=0.7.1.1,+        hspec >=2.7.8,+        hspec-discover >=2.7.8,+        pretty-diff >=0.4.0.0,+        text >=1.2.4.1
+ src/Test/Fluent/Assertions.hs view
@@ -0,0 +1,281 @@+{-# 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 predicate formatter f s = basicAssertion predicate formatter (f 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 = simpleAssertion (a ==) (formatMessage True "should be equal to" a)++isNotEqualTo :: (Eq a, Show a, HasCallStack) => a -> Assertion a+isNotEqualTo a = simpleAssertion (a /=) (formatMessage False "should be not equal to" 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 = simpleAssertion (a <) (formatMessage False "should be greater than" a)++isGreaterEqualThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a+isGreaterEqualThan a = simpleAssertion (a <=) (formatMessage False "should be greater or equal to" 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 = simpleAssertion (a >) (formatMessage False "should be lower than" a)++isLowerEqualThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a+isLowerEqualThan a = simpleAssertion (a >=) (formatMessage False "should be lower or equal to" a)++shouldSatisfy :: (Show a, HasCallStack) => (a -> Bool) -> Assertion a+shouldSatisfy predicate = simpleAssertion predicate (formatMessage' "does not met a predicate")++hasSize :: (Foldable t, HasCallStack) => Int -> Assertion (t a)+hasSize expectedSize = inside length (simpleAssertion (== expectedSize) assertionMessage)+  where+    assertionMessage currentSize = "expected size " <> show expectedSize <> " is not equal actual size " <> show currentSize++isEmpty :: (Foldable t, HasCallStack) => Assertion (t a)+isEmpty = inside null (simpleAssertion (== True) assertionMessage)+  where+    assertionMessage _ = "should be empty, but is not"++isNotEmpty :: (Foldable t, HasCallStack) => Assertion (t a)+isNotEmpty = inside null (simpleAssertion (== False) assertionMessage)+  where+    assertionMessage _ = "should be not empty"++contains :: (Foldable t, Eq a, Show a, HasCallStack) => a -> Assertion (t a)+contains expectedElem = inside (elem expectedElem) (simpleAssertion (== True) assertionMessage)+  where+    assertionMessage _ = "should contain element " <> show expectedElem <> ", 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 f assert s = contramap f (assert (f 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 f assert' b s = b s <> mconcat (transformAssertions [assert' mempty (f s)] 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 label assert s = updateLabel label (assert 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 assert' b s = SequentialAssertions [b s] <> mconcat (transformAssertions [assert' mempty s] id)++formatMessage :: Show a => Bool -> String -> a -> a -> String+formatMessage True message a a' = "given " <> show a' <> " " <> message <> " " <> show a <> "\n" <> pretty a' a+formatMessage False message a a' = "given " <> show a' <> " " <> message <> " " <> show a++formatMessage' :: Show a => String -> a -> String+formatMessage' message a = "given " <> show a <> " " <> message
+ src/Test/Fluent/Assertions/Core.hs view
@@ -0,0 +1,69 @@+{-# OPTIONS_HADDOCK show-extensions #-}++module Test.Fluent.Assertions.Core+  ( -- ** Assertion util functions+    assertThat,+    assertThatIO,+    assertThat',+    assertThatIO',+    assertThrown,+    assertThrown',+    assertThrows',+    assertThrows,+  )+where++import Control.Exception (Exception (fromException), throwIO, try)+import Data.Data (typeOf)+import GHC.Stack (HasCallStack, callStack, getCallStack)+import Test.Fluent.Assertions (FluentTestFailure (..), simpleAssertion)+import Test.Fluent.Assertions.Exceptions (ExceptionSelector)+import Test.Fluent.Internal.AssertionConfig+  ( AssertionConfig,+    defaultConfig,+  )+import Test.Fluent.Internal.Assertions+  ( Assertion',+    assertThat,+    assertThat',+    assertThatIO,+    assertThatIO',+    assertThatIO'',+  )++-- |+-- Module      : Test.Fluent.Assertions.Core+-- Description : Set util function to execute assertions against given value+-- Copyright   : (c) Pawel Nosal, 2021+-- License     : MIT+-- Maintainer  : p.nosal1986@gmail.com+-- Stability   : experimental++-- | Verify if given `IO` action throws expected exception.+assertThrows :: (HasCallStack, Exception e) => IO a -> ExceptionSelector e -> IO ()+assertThrows givenIO selector = assertThrown' defaultConfig givenIO selector (simpleAssertion (const True) (const "should not be invoked"))++assertThrows' :: (HasCallStack, Exception e) => AssertionConfig -> IO a -> ExceptionSelector e -> IO ()+assertThrows' config givenIO selector = assertThrown' config givenIO selector (simpleAssertion (const True) (const "should not be invoked"))++-- | Execute assertions against selected exception+assertThrown :: (HasCallStack, Exception e) => IO a -> ExceptionSelector e -> Assertion' e b -> IO ()+assertThrown = assertThrown' defaultConfig++assertThrown' :: (HasCallStack, Exception e) => AssertionConfig -> IO a -> ExceptionSelector e -> Assertion' e b -> IO ()+assertThrown' config givenIO predicate = assertThatIO'' config givenIO $ \io -> do+  res <- try io+  case res of+    Left e -> do+      let thrownException = show e+      case fromException e of+        Just expectedException -> pure expectedException+        Nothing -> throwIO (FluentTestFailure location [("should throw an exception of type " <> expectedExceptionName <> " , but " <> thrownException <> " has been thrown", location)] 1 0)+    _ -> throwIO (FluentTestFailure location [("should throw an exception of type " <> expectedExceptionName <> ", but it doesn't", location)] 1 0)+  where+    expectedExceptionName = show $ typeOf (exceptionName predicate)+    exceptionName :: (a -> a) -> a+    exceptionName _ = error "instance of Typeable is broken"+    location = case reverse (getCallStack callStack) of+      (_, loc) : _ -> Just loc+      [] -> Nothing
+ src/Test/Fluent/Assertions/Either.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      : Test.Fluent.Assertions.Either+-- Description : Set of assertions for Either type+-- Copyright   : (c) Pawel Nosal, 2021+-- License     : MIT+-- Maintainer  : p.nosal1986@gmail.com+-- Stability   : experimental+--+-- This module provide a set of combinators to assert Either type.+module Test.Fluent.Assertions.Either (isLeft, isRight, extractingRight, extractingLeft) where++import qualified Data.Either as Either+import GHC.Stack (HasCallStack)+import Test.Fluent.Assertions+  ( Assertion,+    Assertion',+    focus,+    forceError,+    inside,+    simpleAssertion,+  )++-- | assert if subject under test is Left+--+-- @+--  assertThat (Left 10) isLeft+-- @+isLeft :: HasCallStack => Assertion (Either a b)+isLeft = inside Either.isLeft (simpleAssertion (== True) assertionMessage)+  where+    assertionMessage _ = "should be Left, but is Right"++-- | assert if subject under test is Right+--+-- @+--  assertThat (Left 10) isRight+-- @+isRight :: HasCallStack => Assertion (Either a b)+isRight = inside Either.isRight (simpleAssertion (== True) assertionMessage)+  where+    assertionMessage _ = "should be Right, but is Left"++-- | assert if subject under test is Right and extract contained value+--+-- @+--  assertThat (Left 10) extractingRight+-- @+extractingRight :: HasCallStack => Assertion' (Either a b) b+extractingRight = forceError isRight . focus (\case (Right a) -> a)++-- | assert if subject under test is Left and extract contained value+--+-- @+--  assertThat (Left 10) extractingLeft+-- @+extractingLeft :: HasCallStack => Assertion' (Either a b) a+extractingLeft = forceError isLeft . focus (\case (Left a) -> a)
+ src/Test/Fluent/Assertions/Exceptions.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      : Test.Fluent.Assertions.Exceptions+-- Description : Set of assertions for Exception type+-- Copyright   : (c) Pawel Nosal, 2021+-- License     : MIT+-- Maintainer  : p.nosal1986@gmail.com+-- Stability   : experimental+--+-- This module provide an assertion for check if expected Exception has been throw by IO action.+module Test.Fluent.Assertions.Exceptions+  ( -- ** Exception selectors+    anyException,+    anyIOException,+    exceptionOfType,++    -- ** Exception selector type+    ExceptionSelector,+  )+where++import Control.Exception+  ( Exception,+    IOException,+    SomeException,+  )++type ExceptionSelector a = a -> a++-- | Select all exceptions.+anyException :: ExceptionSelector SomeException+anyException = id++-- | Select all IOException.+anyIOException :: ExceptionSelector IOException+anyIOException = id++-- | Select all an Exception of given type.+-- This selector should be used with `TypeApplications`+--+-- @+-- data MyException = ThisException | ThatException+--  deriving (Show)+--+-- instance Exception MyException+--+-- selectMyException = exceptionType @MyException+-- @+exceptionOfType :: Exception e => ExceptionSelector e+exceptionOfType = id
+ src/Test/Fluent/Assertions/List.hs view
@@ -0,0 +1,113 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      : Test.Fluent.Assertions.List+-- Description : Set of assertions for List type+-- 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 List type.+module Test.Fluent.Assertions.List where++import Data.List (isPrefixOf)+import GHC.Stack (HasCallStack)+import Test.Fluent.Assertions (Assertion, forceError, simpleAssertion)+import Test.Fluent.Diff (pretty)++-- | assert if given list has same length as expected list+--+-- @+--  assertThat [1..10] $ shouldHaveSameSizeAs [0..10]+-- @+shouldHaveSameSizeAs :: HasCallStack => [a] -> Assertion [a]+shouldHaveSameSizeAs expected = simpleAssertion predicate message+  where+    predicate given = length given == length expected+    message given =+      "should have same leght, but they don't. Given: "+        <> show (length given)+        <> " is not equal to expected "+        <> show (length expected)++-- | verify if the given list has a length lower or equal to expected value+--+-- @+--  assertThat [1..10] $ shouldHaveSizeLowerOrEqual 10+-- @+shouldHaveSizeLowerOrEqual :: HasCallStack => Int -> Assertion [a]+shouldHaveSizeLowerOrEqual expected = simpleAssertion predicate message+  where+    predicate given = length given >= expected+    message given =+      "the lenght of given list is "+        <> show (length given)+        <> ", but should be lower or equal "+        <> show expected++-- | verify if the given list has expected prefix+--+-- @+--  assertThat [1..10] $ shouldStartWith [0..4]+-- @+shouldStartWith :: (Eq a, Show a, HasCallStack) => [a] -> Assertion [a]+shouldStartWith expected = forceError (shouldHaveSizeLowerOrEqual expectedLenght) . simpleAssertion predicate message+  where+    predicate = (expected `isPrefixOf`)+    expectedLenght = length expected+    actualPrefix x = take expectedLenght x+    message x =+      "should start with "+        <> show expected+        <> ", but it start with "+        <> show (actualPrefix x)++-- | verify if the given list does not start with prefix+--+-- @+--  assertThat [1..10] $ shouldNotStartWith [1..4]+-- @+shouldNotStartWith :: (Eq a, Show a, HasCallStack) => [a] -> Assertion [a]+shouldNotStartWith expected = simpleAssertion predicate message+  where+    predicate = not . (expected `isPrefixOf`)+    message _ =+      "should not start with "+        <> show expected+        <> ", but it does"++shouldBeSameAs :: (Eq a, HasCallStack, Show a) => [a] -> Assertion [a]+shouldBeSameAs expected = simpleAssertion predicate message+  where+    predicate = (== expected)+    message given = "given list should be same as expected list, but is not.\n" <> pretty given expected++shouldContain :: (Eq a, HasCallStack, Show a) => a -> Assertion [a]+shouldContain expected = simpleAssertion predicate message+  where+    predicate = elem expected+    message _ = "given list should contain element " <> show expected <> ", but it doesn't."++shouldNotContain :: (Eq a, HasCallStack, Show a) => a -> Assertion [a]+shouldNotContain expected = simpleAssertion predicate message+  where+    predicate = notElem expected+    message _ = "given list should not contain element " <> show expected <> ", but it doesn."++-- | verify if the given list contains same elements as expected list in any order+--+-- @+--  assertThat [1..10] $ shouldNotStartWith [1..4]+-- @+shouldHaveSameElements :: (HasCallStack, Eq a, Show a) => [a] -> Assertion [a]+shouldHaveSameElements expected = forceError (shouldHaveSameSizeAs expected) . simpleAssertion predicate errorMessage+  where+    predicate given = all (`elem` expected) given+    inGiven given = filter (`notElem` given) expected+    inExpected given = filter (`notElem` expected) given+    errorMessage given = "two lists should have same elements but:\n " ++ message+      where+        message = case (inGiven given, inExpected given) of+          ([], []) -> "bug in shouldHaveSameElements assertion, please report this to the maintainer"+          (xs, ys) -> "given list don't have " ++ show xs ++ "\nexpected list don't have " ++ show ys
+ src/Test/Fluent/Assertions/Maybe.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      : Test.Fluent.Assertions.Maybe+-- Description : Set of assertions for Maybe type+-- 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 Maybe type.+module Test.Fluent.Assertions.Maybe (isNothing, isJust, extracting) where++import qualified Data.Maybe as Maybe+import GHC.Stack (HasCallStack)+import Test.Fluent.Assertions+  ( focus,+    forceError,+    inside,+    simpleAssertion,+  )+import Test.Fluent.Internal.Assertions (Assertion, Assertion')++-- | assert if subject under is empty+--+-- @+--  assertThat (Just 10) isNothing+-- @+isNothing :: HasCallStack => Assertion (Maybe a)+isNothing = inside Maybe.isNothing (simpleAssertion (== True) assertionMessage)+  where+    assertionMessage _ = "should be Nothing"++-- | assert if subject under is not empty+--+-- @+--  assertThat (Just 10) isJust+-- @+isJust :: HasCallStack => Assertion (Maybe a)+isJust = inside Maybe.isJust (simpleAssertion (== True) assertionMessage)+  where+    assertionMessage _ = "should be Just"++-- | assert if subject under is not empty and extract contained value+--+-- @+--  assertThat (Just 10) extracting+-- @+extracting :: HasCallStack => Assertion' (Maybe a) a+extracting = forceError isJust . focus Maybe.fromJust
+ src/Test/Fluent/Diff.hs view
@@ -0,0 +1,11 @@+module Test.Fluent.Diff where++import Data.Default (Default (def))+import qualified Data.Text as T+import qualified Pretty.Diff as Diff++pretty :: Show a => a -> a -> String+pretty a b =+  let x = T.pack $ show a+      y = T.pack $ show b+   in T.unpack $ Diff.pretty def x y
+ src/Test/Fluent/Internal/AssertionConfig.hs view
@@ -0,0 +1,17 @@+module Test.Fluent.Internal.AssertionConfig where++newtype AssertionConfig = AssertionConfig+  { assertionTimeout :: Int+  }+  deriving (Show)++-- | Default configuration used for `assertThat` and `assertThatIO`.+-- - default timeout is set to 5 seconds+defaultConfig :: AssertionConfig+defaultConfig =+  AssertionConfig+    5000000 -- 5 seconds++-- | Allow to modify timeout of single assertion+setAssertionTimeout :: Int -> AssertionConfig -> AssertionConfig+setAssertionTimeout newTimeout config = config {assertionTimeout = newTimeout}
+ src/Test/Fluent/Internal/Assertions.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}++module Test.Fluent.Internal.Assertions where++import Control.Exception (Exception, throwIO, try)+import Data.Either (isLeft, lefts, rights)+import Data.Functor.Contravariant (Contravariant (contramap))+import GHC.Exception (SrcLoc, getCallStack)+import GHC.Stack (HasCallStack, callStack)+import System.Timeout (timeout)+import Test.Fluent.Internal.AssertionConfig+  ( AssertionConfig (assertionTimeout),+    defaultConfig,+  )++data FluentTestFailure = FluentTestFailure+  { srcLoc :: !(Maybe SrcLoc),+    msg :: ![(String, Maybe SrcLoc)],+    errorsCount :: !Int,+    successCount :: !Int+  }+  deriving (Show)++instance Exception FluentTestFailure++data AssertionFailure = AssertionFailure+  { message :: !String,+    assertionSrcLoc :: !(Maybe SrcLoc)+  }+  deriving (Show)++instance Exception AssertionFailure++data AssertionDefinition a+  = ParallelAssertions [AssertionDefinition a]+  | SequentialAssertions [AssertionDefinition a]+  | SimpleAssertion+      { assertion :: Maybe String -> a -> IO (),+        label :: Maybe String+      }++instance Show (AssertionDefinition a) where+  show (ParallelAssertions a) = "ParallelAssertions " <> show a+  show (SequentialAssertions a) = "SequentialAssertions " <> show a+  show (SimpleAssertion _ assertionLabel) = "SimpleAssertion - " <> show assertionLabel++instance Contravariant AssertionDefinition where+  contramap f (ParallelAssertions assertions) = ParallelAssertions (fmap (contramap f) assertions)+  contramap f (SequentialAssertions assertions) = SequentialAssertions (fmap (contramap f) assertions)+  contramap f (SimpleAssertion assert assertionLabel) = SimpleAssertion (\l -> assert l . f) assertionLabel++instance Semigroup (AssertionDefinition a) where -- TODO: looks like this instance is not lawful, should be removed and replaced by plain function+  ParallelAssertions a <> ParallelAssertions b = ParallelAssertions (b <> a)+  ParallelAssertions a <> b@(SequentialAssertions _) = ParallelAssertions (b : a)+  SequentialAssertions a <> b@(ParallelAssertions _) = SequentialAssertions (b : a)+  SequentialAssertions a <> SequentialAssertions b = SequentialAssertions (b <> a)+  s@(SimpleAssertion _ _) <> ParallelAssertions a = ParallelAssertions (a ++ [s])+  ParallelAssertions a <> s@(SimpleAssertion _ _) = ParallelAssertions (s : a)+  s@(SimpleAssertion _ _) <> SequentialAssertions a = SequentialAssertions (a ++ [s])+  SequentialAssertions a <> s@(SimpleAssertion _ _) = SequentialAssertions (s : a)+  a@(SimpleAssertion _ _) <> b@(SimpleAssertion _ _) = ParallelAssertions [b, a]++instance Monoid (AssertionDefinition a) where+  mempty = ParallelAssertions []++updateLabel :: String -> AssertionDefinition a -> AssertionDefinition a+updateLabel newLabel (SimpleAssertion assert (Just oldLabel)) = SimpleAssertion assert (Just $ newLabel <> "." <> oldLabel)+updateLabel assertionLabel (SimpleAssertion a Nothing) = SimpleAssertion a (Just assertionLabel)+updateLabel assertionLabel (ParallelAssertions (x : xs)) = ParallelAssertions (updateLabel assertionLabel x : fmap (updateLabel assertionLabel) xs)+updateLabel assertionLabel (SequentialAssertions (x : xs)) = SequentialAssertions (updateLabel assertionLabel x : fmap (updateLabel assertionLabel) xs)+updateLabel _ (ParallelAssertions []) = ParallelAssertions []+updateLabel _ (SequentialAssertions []) = SequentialAssertions []++-- | Execute assertions against given subject under test.+assertThat :: HasCallStack => a -> Assertion' a b -> IO ()+assertThat given = assertThatIO (pure given)++-- | Execute assertions against given subject under test extracted from IO action.+assertThatIO :: HasCallStack => IO a -> Assertion' a b -> IO ()+assertThatIO given = assertThatIO'' defaultConfig given id++-- | A variant of `assertThat` which allow to pass additional configuration.+assertThat' :: HasCallStack => AssertionConfig -> a -> Assertion' a b -> IO ()+assertThat' config given = assertThatIO' config (pure given)++-- | A variant of `assertThatIO` which allow to pass additional configuration.+assertThatIO' :: HasCallStack => AssertionConfig -> IO a -> Assertion' a c -> IO ()+assertThatIO' config givenIO = assertThatIO'' config givenIO id++assertThatIO'' :: HasCallStack => AssertionConfig -> IO a -> (IO a -> IO b) -> Assertion' b c -> IO ()+assertThatIO'' config givenIO f b = do+  given <- f givenIO+  case b (const mempty) given of+    SimpleAssertion assert assertionLabel -> do+      assertionResult <- try (assert assertionLabel given)+      case assertionResult of+        Right () -> pure ()+        Left (AssertionFailure failureMessage assertionLocation) -> throwIO (FluentTestFailure location [(failureMessage, assertionLocation)] 1 0)+    assertions -> do+      assertionResults <- flattenAssertions config given assertions+      let errors = (\assertionError -> (message assertionError, assertionSrcLoc assertionError)) <$> lefts assertionResults+      let successes = length $ rights assertionResults+      if null errors then pure () else throwIO (FluentTestFailure location errors (length errors) successes)+  where+    location = case reverse (getCallStack callStack) of+      (_, loc) : _ -> Just loc+      [] -> Nothing++flattenAssertions :: HasCallStack => AssertionConfig -> a -> AssertionDefinition a -> IO [Either AssertionFailure ()]+flattenAssertions config a (SimpleAssertion assert assertionLabel) = sequence [executeAssertion config assert assertionLabel a]+flattenAssertions config a (ParallelAssertions assertions) = concat <$> traverse (flattenAssertions config a) assertions+flattenAssertions _ _ (SequentialAssertions []) = pure []+flattenAssertions config a (SequentialAssertions (x : xs)) = do+  results <- flattenAssertions config a x+  let isFailed = any isLeft results+  if isFailed+    then pure results+    else flattenAssertions config a (SequentialAssertions xs)++executeAssertion :: HasCallStack => AssertionConfig -> (Maybe String -> t2 -> IO ()) -> Maybe String -> t2 -> IO (Either AssertionFailure ())+executeAssertion config assert assertionLabel given = do+  result <- withTimeout $ do+    !assertionResult <- try $ assert assertionLabel given+    return assertionResult+  case result of+    Nothing ->+      pure (Left $ AssertionFailure (maybe "" (\x -> "[" <> x <> "] ") assertionLabel <> timeoutMessage) location)+    Just a -> pure a+  where+    withTimeout = timeout $ assertionTimeout config+    timeoutMessage = "Timeout occurred, probably some infinitive data structure or not terminating predicate has been used. Timeout: " <> show timeoutInSeconds <> "s"+    timeoutInSeconds :: Double+    timeoutInSeconds = fromIntegral (assertionTimeout config) / 1000000.0+    location :: Maybe SrcLoc+    location = case reverse (getCallStack callStack) of+      (_, loc) : _ -> Just loc+      [] -> Nothing++transformAssertions :: [AssertionDefinition a] -> (b -> a) -> [AssertionDefinition b]+transformAssertions ((SimpleAssertion assert assertionLabel) : xs) f = SimpleAssertion (\l b -> assert (orElse l assertionLabel) (f b)) assertionLabel : transformAssertions xs f+transformAssertions ((ParallelAssertions assertions) : xs) f = ParallelAssertions (transformAssertions assertions f) : transformAssertions xs f+transformAssertions ((SequentialAssertions assertions) : xs) f = SequentialAssertions (transformAssertions assertions f) : transformAssertions xs f+transformAssertions [] _ = []++orElse :: Maybe a -> Maybe a -> Maybe a+x `orElse` y = case x of+  Just _ -> x+  Nothing -> y++basicAssertion :: HasCallStack => (a -> Bool) -> (a -> String) -> AssertionDefinition a -> AssertionDefinition a+basicAssertion predicate messageFormatter b = b <> SimpleAssertion assert Nothing+  where+    assert assertionLabel a' =+      if predicate a'+        then pure ()+        else throwIO (AssertionFailure (maybe "" (\x -> "[" <> x <> "] ") assertionLabel <> messageFormatter a') location)+    location :: Maybe SrcLoc+    location = case reverse (getCallStack callStack) of+      (_, loc) : _ -> Just loc+      [] -> Nothing++basicIOAssertion :: HasCallStack => (a -> Bool) -> (a -> String) -> AssertionDefinition (IO a) -> AssertionDefinition (IO a)+basicIOAssertion predicate messageFormatter b = b <> SimpleAssertion assert Nothing+  where+    assert assertionLabel a' = do+      aaa <- a'+      if predicate aaa+        then pure ()+        else throwIO (AssertionFailure (maybe "" (\x -> "[" <> x <> "] ") assertionLabel <> messageFormatter aaa) location)+    location :: Maybe SrcLoc+    location = case reverse (getCallStack callStack) of+      (_, loc) : _ -> Just loc+      [] -> Nothing++type Assertion'' s t a b = (a -> AssertionDefinition b) -> s -> AssertionDefinition t++type Assertion' a b = Assertion'' a a b b++type Assertion a = Assertion' a a
+ test/AssertionSpecUtils.hs view
@@ -0,0 +1,29 @@+module AssertionSpecUtils where++import Control.Exception (try)+import Data.Bifunctor (Bifunctor (second), first)+import Data.Maybe (listToMaybe)+import GHC.Exception+  ( SrcLoc (SrcLoc, srcLocEndLine, srcLocStartLine),+    getCallStack,+  )+import GHC.Stack (HasCallStack, callStack)+import Test.Fluent.Assertions (FluentTestFailure (msg, srcLoc))++assertionMessage :: HasCallStack => String -> Int -> Int -> (String, Maybe SrcLoc)+assertionMessage message startLine endLine = (message, updateLocation loc)+  where+    loc = snd <$> listToMaybe (getCallStack callStack)+    updateLocation (Just (SrcLoc a b c _ _ _ _)) = Just (SrcLoc a b c startLine 0 endLine 0)+    updateLocation Nothing = Nothing++testLocation :: HasCallStack => Int -> IO () -> IO ((Int, Int), Either FluentTestFailure ())+testLocation offsetLine assertionToTest = do+  res <- try assertionToTest+  let updatedRes = first (\f -> f {srcLoc = updateLocation (srcLoc f), msg = updateAssertionLocation (msg f)}) res+  pure ((srcLocStartLine loc + offsetLine, srcLocEndLine loc + offsetLine), updatedRes)+  where+    loc = snd $ head $ getCallStack callStack+    updateLocation (Just (SrcLoc a b c lineStart _ lineEnd _)) = Just (SrcLoc a b c lineStart 0 lineEnd 0)+    updateLocation Nothing = Nothing+    updateAssertionLocation x = fmap (second updateLocation) x
+ test/Assertions/ListsSpec.hs view
@@ -0,0 +1,66 @@+{-# OPTIONS_GHC -Wno-type-defaults #-}++module Assertions.ListsSpec where++import AssertionSpecUtils (assertionMessage, testLocation)+import Data.Either (fromLeft, isLeft, isRight)+import Test.Fluent.Assertions+  ( FluentTestFailure (FluentTestFailure),+  )+import Test.Fluent.Assertions.Core+  ( assertThat,+  )+import Test.Fluent.Assertions.List+  ( shouldHaveSameElements,+    shouldStartWith,+  )+import Test.Hspec+  ( SpecWith,+    describe,+    hspec,+    it,+    shouldBe,+  )++main :: IO ()+main = hspec spec++spec :: SpecWith ()+spec = do+  describe "lists" $ do+    describe "shouldStartWith" $ do+      it "fail once prefix has more elements than given list" $ do+        ((startLine, endLine), res) <- testLocation 0 $ assertThat [0 .. 9] $ shouldStartWith [0 .. 10]+        isLeft res `shouldBe` True+        let (FluentTestFailure _ messages _ _) = fromLeft undefined res+        messages+          `shouldBe` [assertionMessage "the lenght of given list is 10, but should be lower or equal 11" startLine endLine]+      it "fail once prefix is not same as expected" $ do+        ((startLine, endLine), res) <- testLocation 0 $ assertThat [0 .. 9] $ shouldStartWith [1 .. 10]+        isLeft res `shouldBe` True+        let (FluentTestFailure _ messages _ _) = fromLeft undefined res+        messages+          `shouldBe` [assertionMessage "should start with [1,2,3,4,5,6,7,8,9,10], but it start with [0,1,2,3,4,5,6,7,8,9]" startLine endLine]+      it "success once prefix match expected one" $ do+        (_, res) <- testLocation 0 $ assertThat [0 .. 9] $ shouldStartWith [0 .. 9]+        isRight res `shouldBe` True+    describe "shouldHaveExactSameElements" $ do+      it "fail once two lists have different lenght" $ do+        ((startLine, endLine), res) <- testLocation 0 $ assertThat [0 .. 1000] $ shouldHaveSameElements [500 .. 50090]+        isLeft res `shouldBe` True+        let (FluentTestFailure _ messages _ _) = fromLeft undefined res+        messages+          `shouldBe` [assertionMessage "should have same leght, but they don't. Given: 1001 is not equal to expected 49591" startLine endLine]+      it "fail once list don't have same elements as expected list" $ do+        ((startLine, endLine), res) <- testLocation 0 $ assertThat [1, 2, 3] $ shouldHaveSameElements [1, 2, 4]+        isLeft res `shouldBe` True+        let (FluentTestFailure _ messages _ _) = fromLeft undefined res+        messages+          `shouldBe` [assertionMessage "two lists should have same elements but:\n given list don't have [4]\nexpected list don't have [3]" startLine endLine]+      it "success once two lists are equal" $ do+        let list = [1 .. 100]+        (_, res) <- testLocation 0 $ assertThat list $ shouldHaveSameElements list+        isRight res `shouldBe` True+      it "success once two lists have same elements in different order" $ do+        (_, res) <- testLocation 0 $ assertThat [1, 2, 3, 4, 5] $ shouldHaveSameElements [5, 2, 1, 3, 4]+        isRight res `shouldBe` True
+ test/Assertions/MaybeSpec.hs view
@@ -0,0 +1,58 @@+{-# OPTIONS_GHC -Wno-type-defaults #-}++module Assertions.MaybeSpec where++import AssertionSpecUtils (assertionMessage, testLocation)+import Data.Either (fromLeft, isRight)+import Test.Fluent.Assertions+  ( FluentTestFailure (FluentTestFailure),+    isEqualTo,+  )+import Test.Fluent.Assertions.Core+  ( assertThat,+  )+import Test.Fluent.Assertions.Maybe (extracting, isJust, isNothing)+import Test.Hspec (SpecWith, describe, hspec, it, shouldBe)++main :: IO ()+main = hspec spec++spec :: SpecWith ()+spec = do+  describe "isJust" $ do+    it "should pass" $ do+      (_, res) <- testLocation 0 $ assertThat (Just 10) isJust+      isRight res `shouldBe` True+    it "should fail" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat Nothing isJust+      isRight res `shouldBe` False+      let (FluentTestFailure _ messages _ _) = fromLeft undefined res+      messages `shouldBe` [assertionMessage "should be Just" startLine endLine]+  describe "isNothing" $ do+    it "should pass" $ do+      (_, res) <- testLocation 0 $ assertThat Nothing isNothing+      isRight res `shouldBe` True+    it "should fail" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat (Just 10) isNothing+      isRight res `shouldBe` False+      let (FluentTestFailure _ messages _ _) = fromLeft undefined res+      messages `shouldBe` [assertionMessage "should be Nothing" startLine endLine]+  describe "extracting" $ do+    it "should success when is Just" $ do+      (_, res) <- testLocation 0 $ assertThat (Just 10) extracting+      isRight res `shouldBe` True+    it "should fail when given value is Nothing" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat Nothing extracting+      isRight res `shouldBe` False+      let (FluentTestFailure _ messages _ _) = fromLeft undefined res+      messages+        `shouldBe` [assertionMessage "should be Just" startLine endLine]+    it "should execute assertion on the extracted value" $ do+      (_, res) <- testLocation 0 $ assertThat (Just 10) $ extracting . isEqualTo 10+      isRight res `shouldBe` True+    it "should execute failed assertion on the extracted value" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat (Just 10) $ extracting . isEqualTo 99+      isRight res `shouldBe` False+      let (FluentTestFailure _ messages _ _) = fromLeft undefined res+      messages+        `shouldBe` [assertionMessage "given 10 should be equal to 99\n\9660\9660\n10\n\9591\n\9474\n\9589\n99\n\9650\9650\n" startLine endLine]
+ test/AssertionsSpec.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}++module AssertionsSpec where++import AssertionSpecUtils (assertionMessage, testLocation)+import Data.Either (fromLeft, isRight)+import Data.Function ((&))+import Data.Maybe ()+import GHC.Stack+  ( SrcLoc+      ( SrcLoc+      ),+  )+import Test.Fluent.Assertions+  ( contains,+    defaultConfig,+    hasSize,+    isEmpty,+    isEqualTo,+    isGreaterEqualThan,+    isGreaterThan,+    isLowerEqualThan,+    isLowerThan,+    isNotEmpty,+    isNotEqualTo,+    setAssertionTimeout,+    shouldSatisfy,+  )+import Test.Fluent.Internal.Assertions+  ( FluentTestFailure (FluentTestFailure),+    assertThat,+    assertThat',+  )+import Test.Hspec (Spec, describe, hspec, it, shouldBe)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "chaining assertions" $ do+    it "should accumulate errors" $ do+      ((startLine, endLine), res) <-+        testLocation 1 $+          assertThat "someString" $+            isLowerThan "someString"+              . isNotEqualTo "someString"+              . isGreaterThan "someString"+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 3+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [ assertionMessage "given \"someString\" should be lower than \"someString\"" (startLine + 1) (endLine + 1),+                     assertionMessage "given \"someString\" should be not equal to \"someString\"" (startLine + 2) (endLine + 2),+                     assertionMessage "given \"someString\" should be greater than \"someString\"" (startLine + 3) (endLine + 3)+                   ]+  describe "failing assertions" $ do+    it "isEqualTo should report correct message" $ do+      ((startLine, endLine), res) <-+        testLocation 1 $+          assertThat "someString" $+            isEqualTo "otherString"+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "given \"someString\" should be equal to \"otherString\"\n \9660 \9660\n\"someString\"\n\9591\n\9474\n\9589\n\"otherString\"\n  \9650\9650 \9650\n" (startLine + 1) (endLine + 1)]+    it "isNotEqualTo should report correct message" $ do+      ((startLine, endLine), res) <-+        testLocation 1 $+          assertThat "someString" $+            isNotEqualTo "someString"+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "given \"someString\" should be not equal to \"someString\"" (startLine + 1) (endLine + 1)]+    it "isGreaterThan should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat 5 $ isGreaterThan 6+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "given 5 should be greater than 6" startLine endLine]+    it "isGreaterEqualThan should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat 5 $ isGreaterEqualThan 6+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "given 5 should be greater or equal to 6" startLine endLine]+    it "isLowerThan should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat 5 $ isLowerThan 4+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "given 5 should be lower than 4" startLine endLine]+    it "isLowerEqualThan should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat 5 $ isLowerEqualThan 4+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "given 5 should be lower or equal to 4" startLine endLine]+    it "shouldSatisfy should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat 5 $ shouldSatisfy (< 5)+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "given 5 does not met a predicate" startLine endLine]+    it "hasSize should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat [1 .. 7] $ hasSize 5+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "expected size 5 is not equal actual size 7" startLine endLine]+    it "isEmpty should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat (Just 1) $ isEmpty+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "should be empty, but is not" startLine endLine]+    it "isNotEmpty should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat Nothing $ isNotEmpty+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "should be not empty" startLine endLine]+    it "contains should report correct message" $ do+      ((startLine, endLine), res) <- testLocation 0 $ assertThat (Just 1) $ contains 10+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "should contain element 10, but it doesn't" startLine endLine]+    it "report timeout" $ do+      let config = defaultConfig & setAssertionTimeout 100000+      ((startLine, endLine), res) <- testLocation 0 $ assertThat' config [0 ..] $ isEqualTo [0 ..]+      isRight res `shouldBe` False+      let (FluentTestFailure assertThatLoc messages erros success) = fromLeft undefined res+      erros `shouldBe` 1+      success `shouldBe` 0+      assertThatLoc `shouldBe` Just (SrcLoc "main" "AssertionsSpec" "test/AssertionsSpec.hs" startLine 0 endLine 0)+      messages+        `shouldBe` [assertionMessage "Timeout occurred, probably some infinitive data structure or not terminating predicate has been used. Timeout: 0.1s" startLine endLine]+  describe "success assertions" $ do+    it "isEqualTo should report correct message" $ do+      (_, res) <-+        testLocation 1 $+          assertThat "someString" $+            isEqualTo "someString"+      isRight res `shouldBe` True+    it "isNotEqualTo should report correct message" $ do+      (_, res) <-+        testLocation 1 $+          assertThat "someString" $+            isNotEqualTo "otherString"+      isRight res `shouldBe` True+    it "isGreaterThan should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat 5 $ isGreaterThan 4+      isRight res `shouldBe` True+    it "isGreaterEqualThan should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat 5 $ isGreaterEqualThan 5+      isRight res `shouldBe` True+    it "isLowerThan should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat 5 $ isLowerThan 6+      isRight res `shouldBe` True+    it "isLowerEqualThan should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat 5 $ isLowerEqualThan 5+      isRight res `shouldBe` True+    it "shouldSatisfy should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat 5 $ shouldSatisfy (> 4)+      isRight res `shouldBe` True+    it "hasSize should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat [0 .. 4] $ hasSize 5+      isRight res `shouldBe` True+    it "isEmpty should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat Nothing $ isEmpty+      isRight res `shouldBe` True+    it "isNotEmpty should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat (Just 1) $ isNotEmpty+      isRight res `shouldBe` True+    it "contains should report correct message" $ do+      (_, res) <- testLocation 0 $ assertThat (Just 10) $ contains 10+      isRight res `shouldBe` True
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}