diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for tasty-checklist +## 1.0.2.0 -- 2021-07-25 + * Added `Got` specifier for simpler specification of boolean + `DerivedVal` than using `Val`. + * Better clarity in failure messages. + * Cleaned up documentation and added doctest for ensuring + documentation samples are accurate. + ## 1.0.1.0 -- 2021-06-27 * ASCII output, no UTF-8. diff --git a/src/Test/Tasty/Checklist.hs b/src/Test/Tasty/Checklist.hs --- a/src/Test/Tasty/Checklist.hs +++ b/src/Test/Tasty/Checklist.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -35,13 +36,19 @@ module Test.Tasty.Checklist ( + -- * Checklist testing context withChecklist , CanCheck + -- * Performing or Disabling checks , check , discardCheck + -- * Type-safe multi-check specifications + -- $checkValues + -- $setup , checkValues - , DerivedVal(Val) + , DerivedVal(Val, Got) -- * Error reporting + , CheckResult , ChecklistFailures -- * Displaying tested values , TestShow(testShow) @@ -66,15 +73,15 @@ data ChecklistFailures = ChecklistFailures Text [CheckResult] --- | The 'CheckResult' captures the failure information for a check +-- | The internal 'CheckResult' captures the failure information for a check -data CheckResult = CheckFailed Text Text +data CheckResult = CheckFailed Text Text -- check name from user, fail message instance Exception ChecklistFailures instance Show CheckResult where - show (CheckFailed what val) = - "Failed check of " <> T.unpack what <> " against " <> show val + show (CheckFailed what msg) = + "Failed check of " <> T.unpack what <> " with " <> T.unpack msg instance Show ChecklistFailures where show (ChecklistFailures topMsg fails) = @@ -122,6 +129,8 @@ -- value fails the check. The last argument is the value to check. -- -- >>> :set -XOverloadedStrings +-- >>> import Test.Tasty +-- >>> import Test.Tasty.HUnit -- >>> :{ -- >>> defaultMain $ testCase "odd numbers" $ withChecklist "odds" $ do -- >>> let three = 3 :: Int @@ -130,19 +139,22 @@ -- >>> check "7 + 3 is odd" odd $ 7 + three -- >>> check "7 is odd" odd (7 :: Int) -- >>> :} --- tst1: FAIL --- Exception: ERROR: numbers +-- odd numbers: FAIL +-- Exception: ERROR: odds -- 2 checks failed in this checklist: --- -Failed check of "two is odd" with "2" --- -Failed check of "7 + 3 is odd" with "10" +-- -Failed check of two is odd with 2 +-- -Failed check of 7 + 3 is odd with 10 +-- +-- 1 out of 1 tests failed (...s) +-- *** Exception: ExitFailure 1 -- -- Any check failures are also printed to stdout (and omitted from the -- above for clarity). This is so that those failures are reported -- even if a more standard test assertion is used that prevents --- completion of the checklist. Thus, if an `assertEqual "values" --- three 7` had been added to the above, that would have been the only +-- completion of the checklist. Thus, if an @assertEqual "values" +-- three 7@ had been added to the above, that would have been the only -- actual (and immediate) fail for the test, but any failing 'check's --- appearing before that 'assertEqual' would still have printed. +-- appearing before that @assertEqual@ would still have printed. check :: (CanCheck, TestShow a, MonadIO m) => Text -> (a -> Bool) -> a -> m () @@ -171,6 +183,57 @@ ---------------------------------------------------------------------- +-- $checkValues +-- +-- Implementing a number of discrete 'check' calls can be tedious, +-- especially when they are validating different aspects of the same +-- result value. To facilitate this, the 'checkValues' function can +-- be used along with a type-safe list of checks to perform. +-- +-- To demonstrate this, first consider the following sample program, +-- which has code that generates a complex @Struct@ value, along with +-- tests for various fields in that @Struct@. + +-- $setup +-- >>> :set -XPatternSynonyms +-- >>> :set -XOverloadedStrings +-- >>> +-- >>> import Data.Parameterized.Context ( pattern Empty, pattern (:>) ) +-- >>> import Test.Tasty.Checklist +-- >>> import Test.Tasty +-- >>> import Test.Tasty.HUnit +-- >>> +-- >>> :{ +-- >>> data Struct = MyStruct { foo :: Int, bar :: Char, baz :: String } +-- >>> +-- >>> instance Show Struct where +-- >>> show s = baz s <> " is " <> show (foo s) <> [bar s] +-- >>> instance TestShow Struct where testShow = show +-- >>> +-- >>> someFun :: Int -> Struct +-- >>> someFun n = MyStruct (n * 6) +-- >>> (if n * 6 == 42 then '!' else '?') +-- >>> "The answer to the universe" +-- >>> +-- >>> oddAnswer :: Struct -> Bool +-- >>> oddAnswer = odd . foo +-- >>> +-- >>> test = testCase "someFun result" $ +-- >>> withChecklist "results for someFun" $ +-- >>> someFun 3 `checkValues` +-- >>> (Empty +-- >>> :> Val "foo" foo 42 +-- >>> :> Val "baz field" baz "The answer to the universe" +-- >>> :> Val "shown" show "The answer to the universe is 42!" +-- >>> :> Val "odd answer" oddAnswer False +-- >>> :> Got "even answer" (not . oddAnswer) +-- >>> :> Val "double-checking foo" foo 42 +-- >>> ) +-- >>> :} +-- +-- This code will be used below to demonstrate various advanced +-- checklist capabilities. + -- | The 'checkValues' is a checklist that tests various values that -- can be derived from the input value. The input value is provided, -- along with an 'Data.Parameterized.Context.Assignment' list of @@ -181,43 +244,19 @@ -- This is convenient to gather together a number of validations on a -- single datatype and represent them economically. -- --- One example is testing the fields of a record structure: --- --- > {-# LANGUAGE PatternSynonyms, OverloadedStrings #-} --- > --- > import Data.Parameterized.Context ( pattern Empty, pattern (:>) ) --- > import Test.Tasty.Checklist --- > --- > data Struct = MyStruct { foo :: Int, bar :: Char, baz :: String } --- > --- > instance Show Struct where --- > show s = baz s <> " is " <> foo s <> bar s --- > --- > someFun :: Int -> Struct --- > someFun n = MyStruct (n * 6) --- > (if n * 6 == 42 then '!' else '?') --- > "The answer to the universe" --- > --- > oddAnswer :: Struct -> Bool --- > oddAnswer = odd . foo --- > --- > test = testCase "someFun result" $ --- > someFun 3 `checkValues` --- > (Empty --- > :> Val "foo" foo 42 --- > :> Val "baz field" baz "The answer to the universe" --- > :> Val "shown" show "The answer to the universe is 42!" --- > :> Val "odd answer" oddAnswer False --- > :> Val "double-checking foo" foo 42 --- > ) --- --- Running this test: +-- One example is testing the fields of a record structure, given the +-- above code: -- -- >>> defaultMain test --- ERROR: on input "The answer to the universe is 18?" --- 2 checks failed: --- -Failed check of "foo" with "42" --- -Failed check of "shown" with "The answer to the universe is 42!" +-- someFun result: FAIL +-- Exception: ERROR: results for someFun +-- 3 checks failed in this checklist: +-- -Failed check of foo on input <> expected <<42>> but failed with 18 +-- -Failed check of shown on input <> expected <<"The answer to the universe is 42!">> but failed with "The answer to the universe is 18?" +-- -Failed check of double-checking foo on input <> expected <<42>> but failed with 18 +-- +-- 1 out of 1 tests failed (...s) +-- *** Exception: ExitFailure 1 -- -- In this case, several of the values checked were correct, but more -- than one was wrong. Helpfully, this test output lists /all/ the @@ -233,19 +272,37 @@ chkValue :: CanCheck => TestShow dType => dType -> Ctx.Index idx valType -> DerivedVal dType valType -> IO () -chkValue got _idx (Val txt fld v) = - let r = fld got - msg = txt <> " on input <<" <> ti <> ">> got <<" <> tr <> ">>" - ti = T.pack (testShow got) - tr = T.pack (testShow r) - in check msg (r ==) v - +chkValue got _idx = \case + (Val txt fld v) -> + let r = fld got + msg = txt <> " on input <<" <> ti <> ">> expected <<" <> tv <> ">> but failed" + ti = T.pack (testShow got) + tv = T.pack (testShow v) + in check msg (v ==) r + (Got txt fld) -> + let r = fld got + msg = txt <> " on input <<" <> ti <> ">>" + ti = T.pack (testShow got) + in check msg (True ==) r -- | Each entry in the 'Data.Parameterized.Context.Assignment' list -- for 'checkValues' should be one of these 'DerivedVal' values. data DerivedVal i d where + + -- | Val allows specification of a description string, an extraction + -- function, and the expected value to be extracted. The + -- 'checkValues' function will add a Failure if the expected value is + -- not obtained. Val :: (TestShow d, Eq d) => Text -> (i -> d) -> d -> DerivedVal i d + + -- | Got allow specification of a description string and an + -- extraction function. The 'checkValues' function will add a + -- Failure if the extraction result is False. + -- + -- > Val "what" f True === Got "what" f + -- + Got :: Text -> (i -> Bool) -> DerivedVal i Bool ---------------------------------------------------------------------- diff --git a/tasty-checklist.cabal b/tasty-checklist.cabal --- a/tasty-checklist.cabal +++ b/tasty-checklist.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: tasty-checklist -version: 1.0.1.0 +version: 1.0.2.0 synopsis: Check multiple items during a tasty test description: Allows the test to check a number of items during a test and @@ -60,4 +60,18 @@ , tasty-hunit , tasty-expected-failure , text - + +test-suite checklistDocTests + import: bldspec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: DocTestChecklist.hs + build-depends: base + , HUnit + , doctest >= 0.10 && < 0.17 + , parameterized-utils + , tasty + , tasty-checklist + , tasty-hunit + , text diff --git a/test/DocTestChecklist.hs b/test/DocTestChecklist.hs new file mode 100644 --- /dev/null +++ b/test/DocTestChecklist.hs @@ -0,0 +1,6 @@ +module Main ( main ) where + +import qualified Test.DocTest as T + +main :: IO () +main = T.doctest ["-isrc", "src/Test/Tasty/Checklist.hs"] diff --git a/test/TestChecklist.hs b/test/TestChecklist.hs --- a/test/TestChecklist.hs +++ b/test/TestChecklist.hs @@ -84,6 +84,7 @@ :> Val "baz" baz "The answer to the universe" :> Val "shown" show "The answer to the universe is 42!" :> Val "odd answer" oddAnswer False + :> Got "even answer" (not . oddAnswer) ) 3 @=? (5 :: Int)