TLT 0.2.0.0 → 0.3.0.0

raw patch · 10 files changed

+760/−595 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−3
• TLT.cabal +8/−1
• src/Test/TLT.hs +18/−591
• src/Test/TLT/Assertion.hs +179/−0
• src/Test/TLT/Buffer.hs +42/−0
• src/Test/TLT/Class.hs +142/−0
• src/Test/TLT/Options.hs +33/−0
• src/Test/TLT/Report.hs +117/−0
• src/Test/TLT/Results.hs +58/−0
• src/Test/TLT/Standard.hs +158/−0

@@ -1,11 +1,13 @@ # Changelog for TLT +- 0.3.0 :: Significant refactoring, organizing the contents of the+  module @Test.TLT@ into submodules, with @Test.TLT@ only re-exporting+  the core functionality.+ - 0.2.0 :: Divided the `tlt` function for running tests, to separate   `tltCore` for just running tests from formatted output of test   results.  The former is intended for running TLT in other-  frameworks.--  - Release 0.2.0.0 also prunes some unneeded dependencies.+  frameworks.  Also prunes some unneeded dependencies.  - 0.1.0 :: First release.  Patch 1 re-arranged documentation. 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           TLT-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Testing in monads and transformers without explicit specs description:    A quick-and-dirty unit test system without test specifications, motivated by easy examination of intermediate results of computations in monad transformers.  See the GitHub repository <https://github.com/jphmrst/TLT/> for documentation, or the Haddock page for additional examples. category:       Test@@ -28,6 +28,13 @@ library   exposed-modules:       Test.TLT+      Test.TLT.Assertion+      Test.TLT.Buffer+      Test.TLT.Class+      Test.TLT.Options+      Test.TLT.Report+      Test.TLT.Results+      Test.TLT.Standard   other-modules:       Paths_TLT   hs-source-dirs:

@@ -14,21 +14,20 @@ tests are simply commands in a monad stack which includes the transformer layer @Test.TLT@. -This Haddock page is the main piece of documentation; or see also the-GitHub repository <https://github.com/jphmrst/TLT/>.+This module is a re-exporter for the various @Test.TLT.*@+modules which define distinct portions of the TLT system.  These+exports are oriented towards the simple use of TLT as a test+framework.  When using TLT more programmatically, such as when+integrating TLT into another test framework, it may be necessary+to import the more internally-oriented functions of the+individual modules.  -} -{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- module Test.TLT (+   -- * The TLT transformer-  TLT, tlt, MonadTLT, liftTLT, tltCore,+  TLT, tlt, MonadTLT, liftTLT,   -- ** Session options   reportAllTestResults, setExitAfterFailDisplay,   -- * Writing tests@@ -52,585 +51,13 @@    ) where -import Data.Maybe-import Control.Exception-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.ST.Trans-import Control.Monad.Trans.Class--- import Control.Monad.Trans.Either-import Control.Monad.Trans.Free-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Resource-import Control.Monad.Trans.State.Strict-import qualified Control.Monad.Trans.State.Lazy as SL-import qualified Control.Monad.Trans.Writer.Lazy as WL-import qualified Control.Monad.Trans.Writer.Strict as WS-import System.Console.ANSI-import System.Exit---- * Results of tests---- |Reasons why a test might fail.-data TestFail = Asserted String-                -- ^ A failure arising from an `Assertion` which is not met.-              | Erred String-                -- ^ A failure associated with a call to a Haskell-                -- function triggering an error.--formatFail :: TestFail -> String-formatFail (Asserted s) = s-formatFail (Erred s) = "Assertion raised exception: " ++ s---- |An assertion is a computation (typically in the monad wrapped by--- `TLT`) which returns a list of zero of more reasons for the failure--- of the assertion.  A successful computation returns an empty list:--- no reasons for failure, hence success.-type Assertion m = m [TestFail]---- |Hierarchical structure holding the result of running tests,--- possibly grouped into tests.-data TestResult = Test String [TestFail]-                | Group String Int Int [TestResult]-                  -- ^ The `Int`s are respectively the total number of-                  -- tests executed, and total number of failures-                  -- detected.---- |Return the number of failed tests reported in a `TestResult`.-failCount :: TestResult -> Int-failCount (Test _ []) = 0-failCount (Test _ _) = 1-failCount (Group _ _ n _) = n--testCount :: TestResult -> Int-testCount (Test _ _) = 1-testCount (Group _ n _ _) = n--totalFailCount :: [TestResult] -> Int-totalFailCount = foldr (+) 0 . map failCount--totalTestCount :: [TestResult] -> Int-totalTestCount = foldr (+) 0 . map testCount---- |Report the results of tests.-report :: TLTopts -> [TestResult] -> IO ()-report (TLTopts showPasses exitAfterFailDisplay) trs =-  let fails = totalFailCount trs-      tests = totalTestCount trs-  in do report' "" trs-        if fails > 0-          then do boldRed-                  putStrLn $-                    "Found " ++ show fails ++ " error"-                      ++ (if fails > 1 then "s" else "")-                      ++ " in " ++ show tests ++ " tests; exiting"-                  mediumBlack-                  when exitAfterFailDisplay exitFailure-          else do boldGreen-                  putStrLn $ show tests ++ " test"-                    ++ (if tests > 1 then "s" else "")-                    ++ " passing."-                  mediumBlack-  where report' ind trs = forM_ trs $ \ tr ->-          when (failCount tr > 0 || showPasses) $-            case tr of-              Test s r -> do-                putStr $ ind ++ "- " ++ s ++ ": "-                case r of-                  [] -> do-                    greenPass-                    putStrLn ""-                  x : [] -> do-                    redFail-                    putStrLn $ " " ++ formatFail x-                  _ -> do-                    redFail-                    putStrLn ":"-                    forM_ r $ \ f -> putStrLn $ ind ++ "- " ++ formatFail f-              Group s _ _ trs' -> do-                putStrLn $ ind ++ "- " ++ s ++ ":"-                report' ("  " ++ ind) trs'--boldBlack = setSGR [-  SetColor Foreground Vivid Black, SetConsoleIntensity BoldIntensity ]-boldRed = setSGR [-  SetColor Foreground Vivid Red, SetConsoleIntensity BoldIntensity ]-boldGreen = setSGR [-  SetColor Foreground Vivid Green, SetConsoleIntensity BoldIntensity ]--mediumRed = setSGR [-  SetColor Foreground Vivid Red, SetConsoleIntensity NormalIntensity ]-mediumGreen = setSGR [-  SetColor Foreground Vivid Green, SetConsoleIntensity NormalIntensity ]-mediumBlue = setSGR [-  SetColor Foreground Vivid Blue, SetConsoleIntensity NormalIntensity ]-mediumBlack = setSGR [-  SetColor Foreground Vivid Black, SetConsoleIntensity NormalIntensity ]--greenPass = do-  mediumBlue-  putStr "Pass"-  mediumBlack--redFail = do-  boldRed-  putStr "FAIL"-  mediumBlack---- |Accumulator for test results, in the style of a simplified Huet's--- zipper which only ever adds to the end of the structure.-data TRBuf = Buf TRBuf Int Int String [TestResult] | Top Int Int [TestResult]---- |Add a single test result to a `TRBuf`.-addResult :: TRBuf -> TestResult -> TRBuf-addResult (Top tc fc trs) tr =-  Top (tc + testCount tr) (fc + failCount tr) $ tr : trs-addResult (Buf up tc fc s trs) tr =-  Buf up (tc + testCount tr) (fc + failCount tr) s $ tr : trs---- |Convert the topmost group of a bottom-up `TRBuf` into a completed--- top-down report about the group.-currentGroup :: TRBuf -> TestResult-currentGroup (Buf up tc fc s trs) = Group s tc fc (reverse trs)---- |Derive a new `TRBuf` corresponding to finishing the current group--- and continuing to accumulate results into its enclosure.-popGroup :: TRBuf -> TRBuf-popGroup trb@(Buf acc _ _ _ _) = addResult acc $ currentGroup trb---- |Convert a `TRBuf` into a list of top-down `TestResult`s.-closeTRBuf :: TRBuf -> [TestResult]-closeTRBuf (Top _ _ ts) = reverse ts-closeTRBuf b = closeTRBuf $ popGroup b---- |Record of options which may be specified for running and reporting--- TLT tests.-data TLTopts = TLTopts {-  optShowPasses :: Bool,-  optQuitAfterFailReport :: Bool-}---- |Default initial options-defaultOpts = TLTopts False True---- |Update the display of showing passes in a `TLTopts` record.-withShowPasses :: TLTopts -> Bool -> TLTopts-withShowPasses (TLTopts _ f) b = TLTopts b f---- |Update the display of showing passes in a `TLTopts` record.-withExitAfterFail :: TLTopts -> Bool -> TLTopts-withExitAfterFail (TLTopts p _) b = TLTopts p b---- |Synonym for the elements of the `TLT` state.-type TLTstate = (TLTopts, TRBuf)---- |Monad transformer for TLT tests.  This layer stores the results--- from tests as they are executed.-newtype Monad m => TLT m r = TLT { unwrap :: StateT TLTstate m r }-  deriving (Functor, Applicative, Monad, MonadTrans, MonadIO)--{- ------------------------------------------------------------ -}---- |Extending `TLT` operations across other monad transformers.  For--- easiest and most flexible testing, declare the monad transformers--- of your application as instances of this class.-class (Monad m, Monad n) => MonadTLT m n | m -> n where-  -- |Lift TLT operations within a monad transformer stack.  Note that-  -- with enough transformer types included in this class, the-  -- @liftTLT@ function should usually be unnecessary: the commands in-  -- this module which actually configure testing, or specify a test,-  -- already @liftTLT@ their own result.  So they will all act as-  -- top-level transformers in @MonadTLT@.-  liftTLT :: TLT n a -> m a--instance Monad m => MonadTLT (TLT m) m where-  liftTLT = id--instance (MonadTLT m n, Functor f) => MonadTLT (FreeT f m) n where-    liftTLT = lift . liftTLT--instance MonadTLT m n => MonadTLT (IdentityT m) n where-  liftTLT = lift . liftTLT--instance MonadTLT m n => MonadTLT (MaybeT m) n where-  liftTLT = lift . liftTLT--instance MonadTLT m n => MonadTLT (ReaderT r m) n where-  liftTLT = lift . liftTLT--instance MonadTLT m n => MonadTLT (ResourceT m) n where-  liftTLT = lift . liftTLT--instance MonadTLT m n => MonadTLT (StateT s m) n where-  liftTLT = lift . liftTLT--instance MonadTLT m n => MonadTLT (SL.StateT s m) n where-  liftTLT = lift . liftTLT--instance MonadTLT m n => MonadTLT (STT s m) n where-  liftTLT = lift . liftTLT--instance (MonadTLT m n, Monoid w) => MonadTLT (WL.WriterT w m) n where-  liftTLT = lift . liftTLT--instance (MonadTLT m n, Monoid w) => MonadTLT (WS.WriterT w m) n where-  liftTLT = lift . liftTLT--{- ------------------------------------------------------------ -}---- |Execute the tests specified in a `TLT` monad, and report the--- results as text output.------ When using TLT from some other package (as opposed to using TLT--- itself as your test framework, and wishing to see its--- human-oriented output directly), consider using `tltCore` instead.-tlt :: MonadIO m => TLT m r -> m ()-tlt tlt = do-  liftIO $ putStrLn "Running tests:"-  (opts, results) <- tltCore tlt-  liftIO $ report opts $ results---- |Execute the tests specified in a `TLT` monad without output--- side-effects, returning the final options and result reports.------ This function is primarily useful when calling TLT from some other--- package.  If you are using TLT itself as your test framework, and--- wishing to see its human-oriented output directly, consider using--- `tlt` instead.-tltCore :: MonadIO m => TLT m r -> m (TLTopts, [TestResult])-tltCore (TLT t) = do-  (_, (opts, resultsBuf)) <- runStateT t $ (defaultOpts, Top 0 0 [])-  return (opts, closeTRBuf resultsBuf)---- |This function controls whether `tlt` will report only tests which--- fail, suppressing any display of tests which pass, or else report--- the results of all tests.  The default is the former: the idea is--- that no news should be good news, with the programmer bothered only--- with problems which need fixing.-reportAllTestResults :: MonadTLT m n => Bool -> m ()-reportAllTestResults b = liftTLT $ TLT $ do-  (opts, tr) <- get-  put $ (opts `withShowPasses` b, tr)---- |This function controls whether `tlt` will exit after displaying--- test results which include at least one failing test.  By default,--- it will exit in this situation.  The idea is that a test suite can--- be broken into parts when it makes sense to run the latter parts--- only when the former parts all pass.-setExitAfterFailDisplay :: MonadTLT m n => Bool -> m ()-setExitAfterFailDisplay b = liftTLT $ TLT $ do-  (opts, tr) <- get-  put $ (opts `withExitAfterFail` b, tr)---- |Report a failure.  Useful in pattern-matching cases which are--- entirely not expected.-tltFail :: MonadTLT m n => String -> String -> m ()-desc `tltFail` detail = liftTLT $ TLT $ do-  (opts, before) <- get-  let after = addResult before $ Test desc [Asserted detail]-  put (opts, after)---- |Organize the tests in the given subcomputation as a separate group--- within the test results we will report.-inGroup :: MonadTLT m n => String -> m a -> m a-inGroup name group = do-  (opts, before) <- liftTLT $ TLT get-  liftTLT $ TLT $ put $ (opts, Buf before 0 0 name [])-  result <- group-  (opts', after) <- liftTLT $ TLT $ get-  liftTLT $ TLT $ put $ (opts', popGroup after)-  return result---- * Specifying individual tests--infix 0 ~:, ~::, ~::----- |Label and perform a test of an `Assertion`.------ ===== Example------ > test :: Monad m => TLT m ()--- > test = do--- >   "2 is 2 as result" ~: 2 @== return 2    -- This test passes.--- >   "2 not 3" ~: 2 @/=- 3                   -- This test fails.-(~:) :: MonadTLT m n => String -> Assertion m -> m ()-s ~: a = do-  (opts, oldState) <- liftTLT $ TLT $ get-  assessment <- a-  liftTLT $ TLT $ put (opts, addResult oldState $ Test s assessment)---- |Label and perform a test of a (pure) boolean value.------ ===== Example------ > test :: Monad m => TLT m ()--- > test = do--- >   "True passes" ~::- return True                 -- This test passes.--- >   "2 is 2 as single Bool" ~::- return (2 == 2)   -- This test passes.--- >   "2 is 3!?" ~::- myFn 4 "Hammer"                -- Passes if myFn (which--- >                                                  -- must be monadic)--- >                                                  -- returns True.-(~::-) :: MonadTLT m n => String -> Bool -> m ()-s ~::- b = do-  (opts, oldState) <- liftTLT $ TLT $ get-  liftTLT $ TLT $ put (opts, addResult oldState $ Test s $-        if b then [] else [Asserted $ "Expected True but got False"])---- |Label and perform a test of a boolean value returned by a--- computation in the wrapped monad @m@.------ ===== Example------ > test :: Monad m => TLT m ()--- > test = do--- >   "True passes" ~::- True               -- This test passes.--- >   "2 is 2 as single Bool" ~::- 2 == 2   -- This test passes.--- >   "2 is 3!?" ~::- 2 == 2                -- This test fails.-(~::) :: MonadTLT m n => String -> m Bool -> m ()-s ~:: bM = do-  b <- bM-  (opts, oldState) <- liftTLT $ TLT $ get-  liftTLT $ TLT $ put (opts, addResult oldState $ Test s $-        if b then [] else [Asserted $ "Expected True but got False"])--infix 1 @==,  @/=,  @<,  @>,  @<=,  @>=-infix 1 @==-, @/=-, @<-, @>-, @<=-, @>=----- |Transform a binary function on an expected and an actual value--- (plus a binary generator of a failure message) into an `Assertion`--- for a pure given actual value.------ ===== Example------ TLT's scalar-testing operators like @\@==-@ are defined with this--- function:------ > (@==-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m--- > (@==-) = liftAssertion2Pure (==) $--- >   \ exp actual -> "Expected " ++ show exp ++ " but got " ++ show actual------ The `(==)` operator tests equality, and the result here allows the--- assertion that a value should be exactly equal to a target.  The--- second argument formats the detail reported when the assertion--- fails.-liftAssertion2Pure ::-  (Monad m) => (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m-liftAssertion2Pure tester explainer exp actual = return $-  if (tester exp actual) then [] else [Asserted $ explainer exp actual]---- |Given an `Assertion` for two pure values (expected and actual),--- lift it to an `Assertion` expecting the actual value to be returned--- from a computation.------ ===== Examples------ The TLT assertion `(@==)` lifts `(@==-)` from expecting a pure--- actual result to expecting a computation returning a value to test.------ > (@==) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m--- > (@==) = assertion2PtoM (@==-)-assertion2PtoM ::-  (Monad m) => (a -> a -> Assertion m) -> a -> m a -> Assertion m-assertion2PtoM pa exp actualM = do actual <- actualM-                                   pa exp actual---- |Transform a binary function on expected and actual values (plus--- a generator of a failure message) into an `Assertion` where the--- actual value is to be returned from a subcomputation.-liftAssertion2M ::-  (Monad m) => (a -> a -> Bool) -> (a -> a -> String) -> a -> m a -> Assertion m-liftAssertion2M tester explainer exp actualM =-  let assertPure = liftAssertion2Pure tester explainer exp-  in do actual <- actualM-        assertPure actual---- |Assert that two values are equal.  This assertion takes an--- expected and an actual /value/; see `(@==)` to compare the result--- of a /monadic computation/ to an expected value.------ ===== Examples------ > test :: Monad m => TLT m ()--- > test = do--- >   "Make sure that 2 is still equal to itself" ~: 2 @==- 2--- >   "Make sure that there are four lights" ~: 4 @==- length lights-(@==-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m-(@==-) = liftAssertion2Pure (==) $-  \ exp actual -> "Expected " ++ show exp ++ " but got " ++ show actual---- |Assert that a calculated value is as expected.  This assertion--- compare the result of a /monadic computation/ to an expected value;--- see `(@==-)` to compare an /actual value/ to the expected value.------ ===== Examples------ > test :: Monad m => TLT m ()--- > test = do--- >   "Make sure that 2 is still equal to itself" ~: 2 @== return 2--- >   "Make sure that there are four lights" ~: 4 @== countLights--- >                                             -- where countLights :: m Int-(@==) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m-(@==) = assertion2PtoM (@==-)---- |Assert that two values are not equal.  This assertion takes an--- expected and an actual /value/; see `(@/=)` to compare the result--- of a /monadic computation/ to an expected value.-(@/=-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m-(@/=-) = liftAssertion2Pure (/=) $-  \ exp actual ->-    "Expected other than " ++ show exp ++ " but got " ++ show actual---- |Assert that a calculated value differs from some known value.--- This assertion compares the result of a /monadic computation/ to an--- expected value; see `(@/=-)` to compare an /actual value/ to the--- expected value.-(@/=) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m-(@/=) = assertion2PtoM (@/=-)---- |Assert that a given boundary is strictly less than some value.--- This assertion takes an expected and an actual /value/; see `(@<)`--- to compare the result of a /monadic computation/ to an expected--- value.-(@<-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m-(@<-) = liftAssertion2Pure (<) $-  \ exp actual ->-    "Lower bound (open) is " ++ show exp ++ " but got " ++ show actual---- |Assert that a given, constant boundary is strictly less than some--- calculated value.  This assertion compares the result of a /monadic--- computation/ to an expected value; see `(@<-)` to compare an--- /actual value/ to the expected value.-(@<) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m-(@<) = assertion2PtoM (@<-)---- |Assert that a given boundary is strictly less than some value.--- This assertion takes an expected and an actual /value/; see `(@>)`--- to compare the result of a /monadic computation/ to an expected--- value.-(@>-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m-(@>-) = liftAssertion2Pure (>) $-  \ exp actual ->-    "Upper bound (open) is " ++ show exp ++ " but got " ++ show actual---- |Assert that a given, constant boundary is strictly less than some--- calculated value.  This assertion compares the result of a /monadic--- computation/ to an expected value; see `(@>-)` to compare an--- /actual value/ to the expected value.-(@>) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m-(@>) = assertion2PtoM (@>-)---- |Assert that a given boundary is strictly less than some value.--- This assertion takes an expected and an actual /value/; see `(@<=)`--- to compare the result of a /monadic computation/ to an expected--- value.-(@<=-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m-(@<=-) = liftAssertion2Pure (<=) $-  \ exp actual ->-    "Lower bound (closed) is " ++ show exp ++ " but got " ++ show actual---- |Assert that a given, constant boundary is strictly less than some--- calculated value.  This assertion compares the result of a /monadic--- computation/ to an expected value; see `(@<=-)` to compare an--- /actual value/ to the expected value.-(@<=) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m-(@<=) = assertion2PtoM (@<=-)---- |Assert that a given boundary is strictly less than some value.--- This assertion takes an expected and an actual /value/; see `(@>=)`--- to compare the result of a /monadic computation/ to an expected--- value.-(@>=-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m-(@>=-) = liftAssertion2Pure (>=) $-  \ exp actual ->-    "Upper bound (closed) is " ++ show exp ++ " but got " ++ show actual---- |Assert that a given, constant boundary is strictly less than some--- calculated value.  This assertion compares the result of a /monadic--- computation/ to an expected value; see `(@>=-)` to compare an--- /actual value/ to the expected value.-(@>=) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m-(@>=) = assertion2PtoM (@>=-)---- |This assertion always fails with the given message.-assertFailed :: Monad m => String -> Assertion m-assertFailed msg = return [Asserted msg]---- |This assertion always succeeds.-assertSuccess :: Monad m => Assertion m-assertSuccess = return []---- |Transform a unary function on a value (plus a generator of a--- failure message) into a unary function returning an `Assertion` for--- a pure given actual value.------ ===== Example------ The TLT assertion `emptyP` is built from the `Traversable` predicate--- `null`------ > emptyP :: (Monad m, Traversable t) => t a -> Assertion m--- > emptyP = liftAssertionPure null--- >            (\ _ -> "Expected empty structure but got non-empty")--liftAssertionPure ::-  (Monad m) => (a -> Bool) -> (a -> String) -> a -> Assertion m-liftAssertionPure tester explainer actual = return $-  if (tester actual) then [] else [Asserted $ explainer actual]---- |Given an `Assertion` for a pure (actual) value, lift it to an--- `Assertion` expecting the value to be returned from a computation.------ ===== Example------ The TLT assertion `empty` on monadic computations returning lists--- is defined in terms of the corresponging assertion on pure--- list-valued expressions.------ > empty :: (Monad m, Traversable t) => m (t a) -> Assertion m--- > empty = assertionPtoM emptyP-assertionPtoM :: (Monad m) => (a -> Assertion m) -> m a -> Assertion m-assertionPtoM pa actualM = do actual <- actualM-                              pa actual---- |Transform a unary function on an actual value (plus a generator of--- a failure message) into an `Assertion` where the value is to be--- returned from a subcomputation.-liftAssertionM ::-  (Monad m) => (a -> Bool) -> (a -> String) -> m a -> Assertion m-liftAssertionM tester explainer actualM =-  let assertPure = liftAssertionPure tester explainer-  in do actual <- actualM-        assertPure actual---- |Assert that a pure traversable structure (such as a list) is--- empty.-emptyP :: (Monad m, Traversable t) => t a -> Assertion m-emptyP = liftAssertionPure null-           (\ _ -> "Expected empty structure but got non-empty")---- |Assert that a traversable structure (such as a list) returned from--- a computation is empty.-empty :: (Monad m, Traversable t) => m (t a) -> Assertion m-empty = assertionPtoM emptyP---- |Assert that a pure traversable structure (such as a list) is--- nonempty.-nonemptyP :: (Monad m, Traversable t) => t a -> Assertion m-nonemptyP = liftAssertionPure (not . null)-              (\ _ -> "Expected non-empty structure but got empty")---- |Assert that a traversable structure (such as a list) returned from--- a computation is non-empty.-nonempty :: (Monad m, Traversable t) => m (t a) -> Assertion m-nonempty = assertionPtoM nonemptyP---- |Assert that a `Maybe` value is `Nothing`.-nothingP :: Monad m => Maybe a -> Assertion m-nothingP = liftAssertionPure isNothing-           (\ _ -> "Expected empty Maybe value but got non-Nothing")+-- This package does not actually define any functions; it merely+-- re-exports from the internal packages. --- |Assert that a `Maybe` result ofa computation is `Nothing`.-nothing :: Monad m => m (Maybe a) -> Assertion m-nothing = assertionPtoM nothingP+import Test.TLT.Options+import Test.TLT.Results+import Test.TLT.Buffer+import Test.TLT.Class+import Test.TLT.Report+import Test.TLT.Assertion+import Test.TLT.Standard

@@ -0,0 +1,179 @@+{-|+Module      : Assertion+Description : Assertions and related utilities for TLT+Copyright   : (c) John Maraist, 2022+License     : GPL3+Maintainer  : haskell-tlt@maraist.org+Stability   : experimental+Portability : POSIX++Assertion infrastructure for the @TLT@ testing system.  See `Test.TLT`+for more information.++-}++module Test.TLT.Assertion where++import Control.Monad.Trans.State.Strict+import Test.TLT.Results+import Test.TLT.Buffer+import Test.TLT.Class++-- * Specifying individual tests++-- |An assertion is a computation (typically in the monad wrapped by+-- `TLT`) which returns a list of zero of more reasons for the failure+-- of the assertion.  A successful computation returns an empty list:+-- no reasons for failure, hence success.+type Assertion m = m [TestFail]++-- |This assertion always fails with the given message.+assertFailed :: Monad m => String -> Assertion m+assertFailed msg = return [Asserted msg]++-- |This assertion always succeeds.+assertSuccess :: Monad m => Assertion m+assertSuccess = return []++infix 0 ~:, ~::, ~::-++-- |Label and perform a test of an `Assertion`.+--+-- ===== Example+--+-- > test :: Monad m => TLT m ()+-- > test = do+-- >   "2 is 2 as result" ~: 2 @== return 2    -- This test passes.+-- >   "2 not 3" ~: 2 @/=- 3                   -- This test fails.+(~:) :: MonadTLT m n => String -> Assertion m -> m ()+s ~: a = do+  (opts, oldState) <- liftTLT $ TLT $ get+  assessment <- a+  liftTLT $ TLT $ put (opts, addResult oldState $ Test s assessment)++-- |Label and perform a test of a (pure) boolean value.+--+-- ===== Example+--+-- > test :: Monad m => TLT m ()+-- > test = do+-- >   "True passes" ~::- return True                 -- This test passes.+-- >   "2 is 2 as single Bool" ~::- return (2 == 2)   -- This test passes.+-- >   "2 is 3!?" ~::- myFn 4 "Hammer"                -- Passes if myFn (which+-- >                                                  -- must be monadic)+-- >                                                  -- returns True.+(~::-) :: MonadTLT m n => String -> Bool -> m ()+s ~::- b = do+  (opts, oldState) <- liftTLT $ TLT $ get+  liftTLT $ TLT $ put (opts, addResult oldState $ Test s $+        if b then [] else [Asserted $ "Expected True but got False"])++-- |Label and perform a test of a boolean value returned by a+-- computation in the wrapped monad @m@.+--+-- ===== Example+--+-- > test :: Monad m => TLT m ()+-- > test = do+-- >   "True passes" ~::- True               -- This test passes.+-- >   "2 is 2 as single Bool" ~::- 2 == 2   -- This test passes.+-- >   "2 is 3!?" ~::- 2 == 2                -- This test fails.+(~::) :: MonadTLT m n => String -> m Bool -> m ()+s ~:: bM = do+  b <- bM+  (opts, oldState) <- liftTLT $ TLT $ get+  liftTLT $ TLT $ put (opts, addResult oldState $ Test s $+        if b then [] else [Asserted $ "Expected True but got False"])++-- |Transform a binary function on an expected and an actual value+-- (plus a binary generator of a failure message) into an `Assertion`+-- for a pure given actual value.+--+-- ===== Example+--+-- TLT's scalar-testing operators like @\@==-@ are defined with this+-- function:+--+-- > (@==-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m+-- > (@==-) = liftAssertion2Pure (==) $+-- >   \ exp actual -> "Expected " ++ show exp ++ " but got " ++ show actual+--+-- The `(==)` operator tests equality, and the result here allows the+-- assertion that a value should be exactly equal to a target.  The+-- second argument formats the detail reported when the assertion+-- fails.+liftAssertion2Pure ::+  (Monad m) => (a -> a -> Bool) -> (a -> a -> String) -> a -> a -> Assertion m+liftAssertion2Pure tester explainer exp actual = return $+  if (tester exp actual) then [] else [Asserted $ explainer exp actual]++-- |Given an `Assertion` for two pure values (expected and actual),+-- lift it to an `Assertion` expecting the actual value to be returned+-- from a computation.+--+-- ===== Examples+--+-- The TLT assertion `Test.TLT.(@==)` lifts `Test.TLT.(@==-)` (both+-- defined in `Test.TLT.Standard`) from expecting a pure actual result+-- to expecting a computation returning a value to test.+--+-- > (@==) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m+-- > (@==) = assertion2PtoM (@==-)+assertion2PtoM ::+  (Monad m) => (a -> a -> Assertion m) -> a -> m a -> Assertion m+assertion2PtoM pa exp actualM = do actual <- actualM+                                   pa exp actual++-- |Transform a binary function on expected and actual values (plus+-- a generator of a failure message) into an `Assertion` where the+-- actual value is to be returned from a subcomputation.+liftAssertion2M ::+  (Monad m) => (a -> a -> Bool) -> (a -> a -> String) -> a -> m a -> Assertion m+liftAssertion2M tester explainer exp actualM =+  let assertPure = liftAssertion2Pure tester explainer exp+  in do actual <- actualM+        assertPure actual++-- |Transform a unary function on a value (plus a generator of a+-- failure message) into a unary function returning an `Assertion` for+-- a pure given actual value.+--+-- ===== Example+--+-- The TLT assertion `Test.TLT.emptyP` (defined in+-- `Test.TLT.Standard`) is built from the `Traversable` predicate+-- `null`+--+-- > emptyP :: (Monad m, Traversable t) => t a -> Assertion m+-- > emptyP = liftAssertionPure null+-- >            (\ _ -> "Expected empty structure but got non-empty")++liftAssertionPure ::+  (Monad m) => (a -> Bool) -> (a -> String) -> a -> Assertion m+liftAssertionPure tester explainer actual = return $+  if (tester actual) then [] else [Asserted $ explainer actual]++-- |Given an `Assertion` for a pure (actual) value, lift it to an+-- `Assertion` expecting the value to be returned from a computation.+--+-- ===== Example+--+-- The TLT assertion `Test.TLT.empty` (defined in `Test.TLT.Standard`)+-- on monadic computations returning lists is defined in terms of the+-- corresponging assertion on pure list-valued expressions.+--+-- > empty :: (Monad m, Traversable t) => m (t a) -> Assertion m+-- > empty = assertionPtoM emptyP+assertionPtoM :: (Monad m) => (a -> Assertion m) -> m a -> Assertion m+assertionPtoM pa actualM = do actual <- actualM+                              pa actual++-- |Transform a unary function on an actual value (plus a generator of+-- a failure message) into an `Assertion` where the value is to be+-- returned from a subcomputation.+liftAssertionM ::+  (Monad m) => (a -> Bool) -> (a -> String) -> m a -> Assertion m+liftAssertionM tester explainer actualM =+  let assertPure = liftAssertionPure tester explainer+  in do actual <- actualM+        assertPure actual

@@ -0,0 +1,42 @@+{-|+Module      : Buffer+Description : Testing in a monad transformer layer+Copyright   : (c) John Maraist, 2022+License     : GPL3+Maintainer  : haskell-tlt@maraist.org+Stability   : experimental+Portability : POSIX++Buffer for accumulating test results in the @TLT@ testing system.  See+`Test.TLT` for more information.++-}++module Test.TLT.Buffer where+import Test.TLT.Results++-- |Accumulator for test results, in the style of a simplified Huet's+-- zipper which only ever adds to the end of the structure.+data TRBuf = Buf TRBuf Int Int String [TestResult] | Top Int Int [TestResult]++-- |Add a single test result to a `TRBuf`.+addResult :: TRBuf -> TestResult -> TRBuf+addResult (Top tc fc trs) tr =+  Top (tc + testCount tr) (fc + failCount tr) $ tr : trs+addResult (Buf up tc fc s trs) tr =+  Buf up (tc + testCount tr) (fc + failCount tr) s $ tr : trs++-- |Convert the topmost group of a bottom-up `TRBuf` into a completed+-- top-down report about the group.+currentGroup :: TRBuf -> TestResult+currentGroup (Buf up tc fc s trs) = Group s tc fc (reverse trs)++-- |Derive a new `TRBuf` corresponding to finishing the current group+-- and continuing to accumulate results into its enclosure.+popGroup :: TRBuf -> TRBuf+popGroup trb@(Buf acc _ _ _ _) = addResult acc $ currentGroup trb++-- |Convert a `TRBuf` into a list of top-down `TestResult`s.+closeTRBuf :: TRBuf -> [TestResult]+closeTRBuf (Top _ _ ts) = reverse ts+closeTRBuf b = closeTRBuf $ popGroup b

@@ -0,0 +1,142 @@+{-|+Module      : Class+Description : Testing in a monad transformer layer+Copyright   : (c) John Maraist, 2022+License     : GPL3+Maintainer  : haskell-tlt@maraist.org+Stability   : experimental+Portability : POSIX++Main state and monad definitions for the @TLT@ testing system.  See+`Test.TLT` for more information.++-}++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Test.TLT.Class where++import Control.Exception+import Control.Monad+import Control.Monad.ST.Trans+import Control.Monad.Trans.Class+-- import Control.Monad.Trans.Either+import Control.Monad.Trans.Free+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Resource+import Control.Monad.Trans.State.Strict+import qualified Control.Monad.Trans.State.Lazy as SL+import qualified Control.Monad.Trans.Writer.Lazy as WL+import qualified Control.Monad.Trans.Writer.Strict as WS+import Test.TLT.Options+import Test.TLT.Results+import Test.TLT.Buffer++-- |Synonym for the elements of the `TLT` state.+type TLTstate = (TLTopts, TRBuf)++-- |Monad transformer for TLT tests.  This layer stores the results+-- from tests as they are executed.+newtype Monad m => TLT m r = TLT { unwrap :: StateT TLTstate m r }+  deriving (Functor, Applicative, Monad, MonadTrans)++-- |Extending `TLT` operations across other monad transformers.  For+-- easiest and most flexible testing, declare the monad transformers+-- of your application as instances of this class.+class (Monad m, Monad n) => MonadTLT m n | m -> n where+  -- |Lift TLT operations within a monad transformer stack.  Note that+  -- with enough transformer types included in this class, the+  -- @liftTLT@ function should usually be unnecessary: the commands in+  -- this module which actually configure testing, or specify a test,+  -- already @liftTLT@ their own result.  So they will all act as+  -- top-level transformers in @MonadTLT@.+  liftTLT :: TLT n a -> m a++instance Monad m => MonadTLT (TLT m) m where+  liftTLT = id++instance (MonadTLT m n, Functor f) => MonadTLT (FreeT f m) n where+    liftTLT = lift . liftTLT++instance MonadTLT m n => MonadTLT (IdentityT m) n where+  liftTLT = lift . liftTLT++instance MonadTLT m n => MonadTLT (MaybeT m) n where+  liftTLT = lift . liftTLT++instance MonadTLT m n => MonadTLT (ReaderT r m) n where+  liftTLT = lift . liftTLT++instance MonadTLT m n => MonadTLT (ResourceT m) n where+  liftTLT = lift . liftTLT++instance MonadTLT m n => MonadTLT (StateT s m) n where+  liftTLT = lift . liftTLT++instance MonadTLT m n => MonadTLT (SL.StateT s m) n where+  liftTLT = lift . liftTLT++instance MonadTLT m n => MonadTLT (STT s m) n where+  liftTLT = lift . liftTLT++instance (MonadTLT m n, Monoid w) => MonadTLT (WL.WriterT w m) n where+  liftTLT = lift . liftTLT++instance (MonadTLT m n, Monoid w) => MonadTLT (WS.WriterT w m) n where+  liftTLT = lift . liftTLT++-- |Execute the tests specified in a `TLT` monad without output+-- side-effects, returning the final options and result reports.+--+-- This function is primarily useful when calling TLT from some other+-- package.  If you are using TLT itself as your test framework, and+-- wishing to see its human-oriented output directly, consider using+-- `Test.TLT.tlt` instead.+runTLT :: Monad m => TLT m r -> m (TLTopts, [TestResult])+runTLT (TLT t) = do+  (_, (opts, resultsBuf)) <- runStateT t $ (defaultOpts, Top 0 0 [])+  return (opts, closeTRBuf resultsBuf)++-- |This function controls whether `Test.TLT.tlt` will report only+-- tests which fail, suppressing any display of tests which pass, or+-- else report the results of all tests.  The default is the former:+-- the idea is that no news should be good news, with the programmer+-- bothered only with problems which need fixing.+reportAllTestResults :: MonadTLT m n => Bool -> m ()+reportAllTestResults b = liftTLT $ TLT $ do+  (opts, tr) <- get+  put $ (opts `withShowPasses` b, tr)++-- |This function controls whether the main `Test.TLT.tlt` executable+-- should exit after displaying test results which include at least+-- one failing test.  By default, it will exit in this situation.  The+-- idea is that a test suite can be broken into parts when it makes+-- sense to run the latter parts only when the former parts all pass.+setExitAfterFailDisplay :: MonadTLT m n => Bool -> m ()+setExitAfterFailDisplay b = liftTLT $ TLT $ do+  (opts, tr) <- get+  put $ (opts `withExitAfterFail` b, tr)++-- |Report a failure.  Useful in pattern-matching cases which are+-- entirely not expected.+tltFail :: MonadTLT m n => String -> String -> m ()+desc `tltFail` detail = liftTLT $ TLT $ do+  (opts, before) <- get+  let after = addResult before $ Test desc [Asserted detail]+  put (opts, after)++-- |Organize the tests in the given subcomputation as a separate group+-- within the test results we will report.+inGroup :: MonadTLT m n => String -> m a -> m a+inGroup name group = do+  (opts, before) <- liftTLT $ TLT get+  liftTLT $ TLT $ put $ (opts, Buf before 0 0 name [])+  result <- group+  (opts', after) <- liftTLT $ TLT $ get+  liftTLT $ TLT $ put $ (opts', popGroup after)+  return result

@@ -0,0 +1,33 @@+{-|+Module      : Options+Description : Option spec for TLT+Copyright   : (c) John Maraist, 2022+License     : GPL3+Maintainer  : haskell-tlt@maraist.org+Stability   : experimental+Portability : POSIX++Options representation for the @TLT@ testing system.  See `Test.TLT`+for more information.++-}++module Test.TLT.Options where++-- |Record of options which may be specified for running and reporting+-- TLT tests.+data TLTopts = TLTopts {+  optShowPasses :: Bool,+  optQuitAfterFailReport :: Bool+}++-- |Default initial options.+defaultOpts = TLTopts False True++-- |Update the display of showing passes in a `TLTopts` record.+withShowPasses :: TLTopts -> Bool -> TLTopts+withShowPasses (TLTopts _ f) b = TLTopts b f++-- |Update the display of showing passes in a `TLTopts` record.+withExitAfterFail :: TLTopts -> Bool -> TLTopts+withExitAfterFail (TLTopts p _) b = TLTopts p b

@@ -0,0 +1,117 @@+{-|+Module      : Report+Description : Testing in a monad transformer layer+Copyright   : (c) John Maraist, 2022+License     : GPL3+Maintainer  : haskell-tlt@maraist.org+Stability   : experimental+Portability : POSIX++Default results reporting for the @TLT@ testing system.  See+`Test.TLT` for more information.++-}++{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Test.TLT.Report where+import Control.Monad+import Control.Monad.IO.Class+import System.Console.ANSI+import System.Exit+import Test.TLT.Options+import Test.TLT.Results+import Test.TLT.Class++-- |Execute the tests specified in a `TLT` monad, and report the+-- results as text output.+--+-- When using TLT from some other package (as opposed to using TLT+-- itself as your test framework, and wishing to see its+-- human-oriented output directly), consider using `runTLT` instead.+tlt :: MonadIO m => TLT m r -> m ()+tlt tlt = do+  liftIO $ putStrLn "Running tests:"+  (opts, results) <- runTLT tlt+  liftIO $ report opts $ results++-- |Report the results of tests.+report :: TLTopts -> [TestResult] -> IO ()+report (TLTopts showPasses exitAfterFailDisplay) trs =+  let fails = totalFailCount trs+      tests = totalTestCount trs+  in do report' "" trs+        if fails > 0+          then do boldRed+                  putStrLn $+                    "Found " ++ show fails ++ " error"+                      ++ (if fails > 1 then "s" else "")+                      ++ " in " ++ show tests ++ " tests; exiting"+                  mediumBlack+                  when exitAfterFailDisplay exitFailure+          else do boldGreen+                  putStrLn $ show tests ++ " test"+                    ++ (if tests > 1 then "s" else "")+                    ++ " passing."+                  mediumBlack+  where report' ind trs = forM_ trs $ \ tr ->+          when (failCount tr > 0 || showPasses) $+            case tr of+              Test s r -> do+                putStr $ ind ++ "- " ++ s ++ ": "+                case r of+                  [] -> do+                    greenPass+                    putStrLn ""+                  x : [] -> do+                    redFail+                    putStrLn $ " " ++ formatFail x+                  _ -> do+                    redFail+                    putStrLn ":"+                    forM_ r $ \ f -> putStrLn $ ind ++ "- " ++ formatFail f+              Group s _ _ trs' -> do+                putStrLn $ ind ++ "- " ++ s ++ ":"+                report' ("  " ++ ind) trs'++-- |Command to set an ANSI terminal to boldface black.+boldBlack = setSGR [+  SetColor Foreground Vivid Black, SetConsoleIntensity BoldIntensity ]+-- |Command to set an ANSI terminal to boldface red.+boldRed = setSGR [+  SetColor Foreground Vivid Red, SetConsoleIntensity BoldIntensity ]+-- |Command to set an ANSI terminal to boldface green.+boldGreen = setSGR [+  SetColor Foreground Vivid Green, SetConsoleIntensity BoldIntensity ]++-- |Command to set an ANSI terminal to medium-weight red.+mediumRed = setSGR [+  SetColor Foreground Vivid Red, SetConsoleIntensity NormalIntensity ]+-- |Command to set an ANSI terminal to medium-weight green.+mediumGreen = setSGR [+  SetColor Foreground Vivid Green, SetConsoleIntensity NormalIntensity ]+-- |Command to set an ANSI terminal to medium-weight blue.+mediumBlue = setSGR [+  SetColor Foreground Vivid Blue, SetConsoleIntensity NormalIntensity ]+-- |Command to set an ANSI terminal to medium-weight black.+mediumBlack = setSGR [+  SetColor Foreground Vivid Black, SetConsoleIntensity NormalIntensity ]++-- |Command to set an ANSI terminal to the standard TLT weight and+-- color for a passing test.+greenPass = do+  mediumBlue+  putStr "Pass"+  mediumBlack++-- |Command to set an ANSI terminal to the standard TLT weight and+-- color for a failing test.+redFail = do+  boldRed+  putStr "FAIL"+  mediumBlack

@@ -0,0 +1,58 @@+{-|+Module      : Results+Description : Results representation for TLT+Copyright   : (c) John Maraist, 2022+License     : GPL3+Maintainer  : haskell-tlt@maraist.org+Stability   : experimental+Portability : POSIX++Results representation for the @TLT@ testing system.  See `Test.TLT`+for more information.++-}++module Test.TLT.Results where++-- * Results of tests++-- |Reasons why a test might fail.+data TestFail = Asserted String+                -- ^ A failure arising from an `Test.TLT.Assertion`+                -- which is not met.+              | Erred String+                -- ^ A failure associated with a call to a Haskell+                -- function triggering an error.++-- |Default conversion of a `TestFail` to a descriptive string.+formatFail :: TestFail -> String+formatFail (Asserted s) = s+formatFail (Erred s) = "Assertion raised exception: " ++ s++-- |Hierarchical structure holding the result of running tests,+-- possibly grouped into tests.+data TestResult = Test String [TestFail]+                | Group String Int Int [TestResult]+                  -- ^ The `Int`s are respectively the total number of+                  -- tests executed, and total number of failures+                  -- detected.++-- |Return the number of failed tests reported in a `TestResult`.+failCount :: TestResult -> Int+failCount (Test _ []) = 0+failCount (Test _ _) = 1+failCount (Group _ _ n _) = n++-- |Return the number of tests described by a `TestResult`.+testCount :: TestResult -> Int+testCount (Test _ _) = 1+testCount (Group _ n _ _) = n++-- |Return the number of failed tests described in a list of+-- `TestResult`s.+totalFailCount :: [TestResult] -> Int+totalFailCount = foldr (+) 0 . map failCount++-- |Return the number of tests described in a list of `TestResult`s.+totalTestCount :: [TestResult] -> Int+totalTestCount = foldr (+) 0 . map testCount

@@ -0,0 +1,158 @@+{-|+Module      : Standard+Description : Standard test operations for TLT+Copyright   : (c) John Maraist, 2022+License     : GPL3+Maintainer  : haskell-tlt@maraist.org+Stability   : experimental+Portability : POSIX++Standard assertion vocabulary for the @TLT@ testing system.  See+`Test.TLT` for more information.++-}++module Test.TLT.Standard where+import Data.Maybe+import Test.TLT.Assertion++infix 1 @==,  @/=,  @<,  @>,  @<=,  @>=+infix 1 @==-, @/=-, @<-, @>-, @<=-, @>=-++-- |Assert that two values are equal.  This assertion takes an+-- expected and an actual /value/; see `(@==)` to compare the result+-- of a /monadic computation/ to an expected value.+--+-- ===== Examples+--+-- > test :: Monad m => TLT m ()+-- > test = do+-- >   "Make sure that 2 is still equal to itself" ~: 2 @==- 2+-- >   "Make sure that there are four lights" ~: 4 @==- length lights+(@==-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m+(@==-) = liftAssertion2Pure (==) $+  \ exp actual -> "Expected " ++ show exp ++ " but got " ++ show actual++-- |Assert that a calculated value is as expected.  This assertion+-- compare the result of a /monadic computation/ to an expected value;+-- see `(@==-)` to compare an /actual value/ to the expected value.+--+-- ===== Examples+--+-- > test :: Monad m => TLT m ()+-- > test = do+-- >   "Make sure that 2 is still equal to itself" ~: 2 @== return 2+-- >   "Make sure that there are four lights" ~: 4 @== countLights+-- >                                             -- where countLights :: m Int+(@==) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m+(@==) = assertion2PtoM (@==-)++-- |Assert that two values are not equal.  This assertion takes an+-- expected and an actual /value/; see `(@/=)` to compare the result+-- of a /monadic computation/ to an expected value.+(@/=-) :: (Monad m, Eq a, Show a) => a -> a -> Assertion m+(@/=-) = liftAssertion2Pure (/=) $+  \ exp actual ->+    "Expected other than " ++ show exp ++ " but got " ++ show actual++-- |Assert that a calculated value differs from some known value.+-- This assertion compares the result of a /monadic computation/ to an+-- expected value; see `(@/=-)` to compare an /actual value/ to the+-- expected value.+(@/=) :: (Monad m, Eq a, Show a) => a -> m a -> Assertion m+(@/=) = assertion2PtoM (@/=-)++-- |Assert that a given boundary is strictly less than some value.+-- This assertion takes an expected and an actual /value/; see `(@<)`+-- to compare the result of a /monadic computation/ to an expected+-- value.+(@<-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m+(@<-) = liftAssertion2Pure (<) $+  \ exp actual ->+    "Lower bound (open) is " ++ show exp ++ " but got " ++ show actual++-- |Assert that a given, constant boundary is strictly less than some+-- calculated value.  This assertion compares the result of a /monadic+-- computation/ to an expected value; see `(@<-)` to compare an+-- /actual value/ to the expected value.+(@<) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m+(@<) = assertion2PtoM (@<-)++-- |Assert that a given boundary is strictly less than some value.+-- This assertion takes an expected and an actual /value/; see `(@>)`+-- to compare the result of a /monadic computation/ to an expected+-- value.+(@>-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m+(@>-) = liftAssertion2Pure (>) $+  \ exp actual ->+    "Upper bound (open) is " ++ show exp ++ " but got " ++ show actual++-- |Assert that a given, constant boundary is strictly less than some+-- calculated value.  This assertion compares the result of a /monadic+-- computation/ to an expected value; see `(@>-)` to compare an+-- /actual value/ to the expected value.+(@>) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m+(@>) = assertion2PtoM (@>-)++-- |Assert that a given boundary is strictly less than some value.+-- This assertion takes an expected and an actual /value/; see `(@<=)`+-- to compare the result of a /monadic computation/ to an expected+-- value.+(@<=-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m+(@<=-) = liftAssertion2Pure (<=) $+  \ exp actual ->+    "Lower bound (closed) is " ++ show exp ++ " but got " ++ show actual++-- |Assert that a given, constant boundary is strictly less than some+-- calculated value.  This assertion compares the result of a /monadic+-- computation/ to an expected value; see `(@<=-)` to compare an+-- /actual value/ to the expected value.+(@<=) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m+(@<=) = assertion2PtoM (@<=-)++-- |Assert that a given boundary is strictly less than some value.+-- This assertion takes an expected and an actual /value/; see `(@>=)`+-- to compare the result of a /monadic computation/ to an expected+-- value.+(@>=-) :: (Monad m, Ord a, Show a) => a -> a -> Assertion m+(@>=-) = liftAssertion2Pure (>=) $+  \ exp actual ->+    "Upper bound (closed) is " ++ show exp ++ " but got " ++ show actual++-- |Assert that a given, constant boundary is strictly less than some+-- calculated value.  This assertion compares the result of a /monadic+-- computation/ to an expected value; see `(@>=-)` to compare an+-- /actual value/ to the expected value.+(@>=) :: (Monad m, Ord a, Show a) => a -> m a -> Assertion m+(@>=) = assertion2PtoM (@>=-)++-- |Assert that a pure traversable structure (such as a list) is+-- empty.+emptyP :: (Monad m, Traversable t) => t a -> Assertion m+emptyP = liftAssertionPure null+           (\ _ -> "Expected empty structure but got non-empty")++-- |Assert that a traversable structure (such as a list) returned from+-- a computation is empty.+empty :: (Monad m, Traversable t) => m (t a) -> Assertion m+empty = assertionPtoM emptyP++-- |Assert that a pure traversable structure (such as a list) is+-- nonempty.+nonemptyP :: (Monad m, Traversable t) => t a -> Assertion m+nonemptyP = liftAssertionPure (not . null)+              (\ _ -> "Expected non-empty structure but got empty")++-- |Assert that a traversable structure (such as a list) returned from+-- a computation is non-empty.+nonempty :: (Monad m, Traversable t) => m (t a) -> Assertion m+nonempty = assertionPtoM nonemptyP++-- |Assert that a `Maybe` value is `Nothing`.+nothingP :: Monad m => Maybe a -> Assertion m+nothingP = liftAssertionPure isNothing+           (\ _ -> "Expected empty Maybe value but got non-Nothing")++-- |Assert that a `Maybe` result of a computation is `Nothing`.+nothing :: Monad m => m (Maybe a) -> Assertion m+nothing = assertionPtoM nothingP