assert4hs-tasty (empty) → 0.0.0.1

raw patch · 7 files changed

+244/−0 lines, 7 filesdep +assert4hsdep +assert4hs-tastydep +basesetup-changed

Dependencies added: assert4hs, assert4hs-tasty, base, tasty

Files

• ChangeLog.md +7/−0
• LICENSE +21/−0
• README.md +108/−0
• Setup.hs +2/−0
• assert4hs-tasty.cabal +56/−0
• src/Test/Fluent/Tasty/TestCase.hs +48/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,7 @@+# Changelog for assert4hs-tasty++## 0.0.0.1++- Initial release++## Unreleased changes

@@ -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.

@@ -0,0 +1,108 @@+# assert4hs-tasty++assert4hs provider for tasty++### Example++```haskell++data Foo = Foo {name :: String, age :: Int} deriving (Show, Eq)++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))++unitTests :: TestTree+unitTests =+  testGroup+    "Unit tests"+    [ +      fluentTestCase "chaining assertions" $ do+        let result = 4+        assertThat result $+          isGreaterThan 5+            . isLowerThan 20,+      fluentTestCase "focusing on part of data structure" $ do+        assertThat (Foo "someName" 15) $+          isEqualTo (Foo "someName" 15)+            . focus age+            . isGreaterThan 20+            . isLowerEqualThan 5,+      fluentTestCase "Changing subject uder test" $ do+        assertThat (Foo "someName" 15) $+          inside age (isGreaterThan 20 . isLowerEqualThan 5)+            . focus name+            . isEqualTo "someName1",+      fluentTestCase "Tagging assertions" $ do+        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",+      fluentTestCase "Custom assertions" $ do+        assertThat (Foo "someName" 15) isSuitableForEmployment,+        fluentTestCase "Custom assertions" $ do+        assertThat (Foo "someName" 76) isSuitableForEmployment+    ]++>>> Progress 1/2: assert4hsTests+>>>   Unit tests+>>>     chaining assertions:                FAIL+>>>       (test/Spec.hs:46): +>>>       given 4 should be greater than 5+>>>     passed: 1, failed: 1, total: 2+>>>     focusing on part of data structure: FAIL+>>>       (test/Spec.hs:52): +>>>       given 15 should be greater than 20+>>>       +>>>       (test/Spec.hs:53): +>>>       given 15 should be lower or equal to 5+>>>     passed: 1, failed: 2, total: 3+>>>     Changing subject uder test:         FAIL+>>>       (test/Spec.hs:56): +>>>       given 15 should be greater than 20+>>>       +>>>       (test/Spec.hs:56): +>>>       given 15 should be lower or equal to 5+>>>       +>>>       (test/Spec.hs:58): +>>>       given "someName" should be equal to "someName1"+>>>       "someName"+>>>       ╷+>>>       │+>>>       ╵+>>>       "someName1"+>>>                ▲+>>>     passed: 0, failed: 3, total: 3+>>>     Tagging assertions:                 FAIL+>>>       (test/Spec.hs:61): +>>>       [age] given 15 should be greater than 20+>>>       +>>>       (test/Spec.hs:61): +>>>       [age] given 15 should be lower or equal to 5+>>>       +>>>       (test/Spec.hs:64): +>>>       [name] given "someName" should be equal to "someName1"+>>>       "someName"+>>>       ╷+>>>       │+>>>       ╵+>>>       "someName1"+>>>                ▲+>>>       (test/Spec.hs:66): +>>>       [name.should not be equal] given "someName" should be not equal to "someName"+>>>     passed: 0, failed: 4, total: 4+>>>     Custom assertions:                  FAIL+>>>       (test/Spec.hs:35): +>>>       new employee must be 18 years or older, but it has 15+>>>     passed: 1, failed: 1, total: 2+>>>     Custom assertions:                  FAIL+>>>       (test/Spec.hs:36): +>>>       must be younger than 70 years old, but it has 76+>>>     passed: 1, failed: 1, total: 2+>>> +>>> 6 out of 6 tests failed (0.01s)+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,56 @@+cabal-version:      1.12+name:               assert4hs-tasty+version:            0.0.0.1+license:            MIT+license-file:       LICENSE+copyright:          2021 Pawel Nosal+maintainer:         p.nosal1986@gmail.com+author:             Pawel Nosal+homepage:           https://github.com/paweln1986/assert4hs-tasty#readme+bug-reports:        https://github.com/paweln1986/assert4hs-tasty/issues+synopsis:           Provider for tasty runner to run assert4hs tests+description:+    Please see the README on GitHub at <https://github.com/paweln1986/assert4hs-tasty#readme>++category:           Web+build-type:         Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+    type:     git+    location: https://github.com/paweln1986/assert4hs-tasty++library+    exposed-modules:  Test.Fluent.Tasty.TestCase+    hs-source-dirs:   src+    other-modules:    Paths_assert4hs_tasty+    default-language: Haskell2010+    ghc-options:+        -haddock -Wall -Wcompat -Wincomplete-record-updates+        -Wincomplete-uni-patterns -Wredundant-constraints+        -Wno-unused-do-bind -Werror=incomplete-patterns++    build-depends:+        assert4hs >=0.0.0.1,+        base >=4.7 && <5,+        tasty >=1.4.1++test-suite assert4hs-tasty-test+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    hs-source-dirs:   test+    other-modules:    Paths_assert4hs_tasty+    default-language: Haskell2010+    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 >=0.0.0.1,+        assert4hs-tasty -any,+        base >=4.7 && <5,+        tasty >=1.4.1

@@ -0,0 +1,48 @@+module Test.Fluent.Tasty.TestCase (fluentTestCase) where++import Control.Exception (try)+import Data.Data (Typeable)+import Data.List (intercalate)+import GHC.Exception (SrcLoc (srcLocFile, srcLocStartLine))+import Test.Fluent.Assertions+  ( FluentTestFailure (FluentTestFailure),+  )+import Test.Tasty.Providers+  ( IsTest (..),+    TestName,+    TestTree,+    singleTest,+    testFailedDetails,+    testPassed,+  )+import Test.Tasty.Providers.ConsoleFormat+  ( ResultDetailsPrinter (..),+    failFormat,+  )++newtype FluentTestCase = FluentTestCase (IO String)+  deriving (Typeable)++failedAssertionResultPrinter :: Int -> Int -> ResultDetailsPrinter+failedAssertionResultPrinter errors successes = ResultDetailsPrinter $ \ident formater ->+  formater failFormat (putStrLn $ replicate (ident + 2) ' ' ++ "passed: " ++ show successes ++ ", failed: " ++ show errors ++ ", total: " ++ show (errors + successes))++instance IsTest FluentTestCase where+  run _ (FluentTestCase assertions) _ = do+    result <- try assertions+    pure $+      case result of+        Right info -> testPassed info+        Left (FluentTestFailure _ msg errors successes) -> testFailedDetails (prependLocation msg) (failedAssertionResultPrinter errors successes)+  testOptions = pure []++prependLocation :: [(String, Maybe SrcLoc)] -> String+prependLocation assertionErrors = intercalate "\n\n" $ fmap toLine assertionErrors+  where+    toLine (s, mbloc) = case mbloc of+      Nothing -> s+      Just loc -> "(" <> srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) <> "): \n" <> s++-- | transform assert4hs assertion into tasty TestTree+fluentTestCase :: TestName ->  IO () ->   TestTree+fluentTestCase name = singleTest name . FluentTestCase . fmap (const "")

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"