TLT 0.3.0.0 → 0.4.0.0

raw patch · 7 files changed

+324/−13 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• TLT.cabal +1/−1
• app/Failing.hs +29/−2
• src/Test/TLT.hs +157/−9
• src/Test/TLT/Class.hs +113/−1
• src/Test/TLT/Standard.hs +1/−0
• test/Passing.hs +18/−0

@@ -1,5 +1,10 @@ # Changelog for TLT +- 0.4.0 :: Adding a class, instance declarations, and functions for+  inspecting exceptions thrown from an `ExceptT` transformer layer.+  +  Corrections to the Haddock documentation.+ - 0.3.0 :: Significant refactoring, organizing the contents of the   module @Test.TLT@ into submodules, with @Test.TLT@ only re-exporting   the core functionality.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           TLT-version:        0.3.0.0+version:        0.4.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

@@ -1,10 +1,14 @@ import Test.TLT+import Control.Monad.Trans.Except+import Control.Monad.Trans.Identity+import Control.Monad.Trans+import Control.Monad  main :: IO () main = do-  tlt test+  tlt $ runExceptT test -test :: Monad m => TLT m ()+test :: ExceptT String (TLT IO) () test = do   "True passes" ~::- True   "2 is 3 as single Bool" ~::- 2 == 3@@ -21,3 +25,26 @@     "2 not 2" ~: 2 @/=- 2   "2 not 3 as result" ~: 2 @/= return 3   "2 not 2 as result" ~: 2 @/= return 2+  noUncaught "extest1" $ do+    "6 is 6 as pure assertion" ~: 6 @==- 6+    "7 is 7 as pure assertion" ~: 7 @==- 7++  noUncaught "extest1x" $ do+    "6 is 6 as pure assertion" ~: 6 @==- 6+    throwE "Boom"+    "7 is 7 as pure assertion" ~: 7 @==- 7+  uncaught "extest2" $ do+    "8 is 8 as pure assertion" ~: 8 @==- 8+    throwE "Boom"+    "9 is 9 as pure assertion" ~: 9 @==- 9+  uncaught "extest2x" $ do+    "8 is 8 as pure assertion" ~: 8 @==- 8+    "9 is 9 as pure assertion" ~: 9 @==- 9++  uncaughtWith "extest3" (do "10 is 10 as pure assertion" ~: 10 @==- 10+                             throwE "Boom"+                             "11 is 11 as pure assertion" ~: 11 @==- 11) h+  uncaughtWith "extest3x" (do "10 is 10 as pure assertion" ~: 10 @==- 10+                              "11 is 11 as pure assertion" ~: 11 @==- 11) h+  where h :: String -> ExceptT String (TLT IO) ()+        h e = lift ("The exception should be \"Boom\"" ~: "Boom" @==- e)

@@ -26,28 +26,175 @@  module Test.TLT ( +  -- * Introduction and basic use++  -- | The basic use of TLT is a call to @tlt@ in the @main@ function+  -- of a program, followed by a monadic computation which asserts+  -- various properties about the results it calculates.  For example:+  --+  -- > main :: IO ()+  -- > main = tlt $ runExceptT test+  -- >   "True passes" ~::- True+  -- >   "1 and 1 make 2" ~: 2 @== return (1 + 1)++  tlt,++  -- ** Writing tests++  -- | The two tests in the example above have the common form of one+  -- individual TLT test:+  --+  -- >  LABLE TEST-OPERATOR EXPRESSION+  --+  -- There are three @TEST-OPERATOR@s, corresponding to three+  -- different forms of @EXPRESSION@:+  --+  -- +----------+----------------------------------------------------++  -- | OPERATOR | EXPRESSION                                         |+  -- +==========+====================================================++  -- | `~:`     | The expression is an assertion written with one of |+  -- |          | the several operators below.                       |+  -- +----------+----------------------------------------------------++  -- | `~::`    | The expression is a monadic computation returning  |+  -- |          | a boolean value, where @True@ corresponds to the   |+  -- |          | test passing.                                      |+  -- +----------+----------------------------------------------------++  -- | `~::-`   | The expression is a simple boolean value, where    |+  -- |          | again @True@ corresponds to the test passing.      |+  -- +----------+----------------------------------------------------++  --+  -- The last two of these test-introducung operations show a pattern+  -- that recrus throughout TLT: where two operators differ only where+  -- one has a trailing hyphen, the version __without__ the hyphen+  -- refers to a monadic computation, and the version __with__ the+  -- hyphen refers to a pure expression.++  -- | There are a number of special forms of test, and commands for+  -- setting session options.+  --+  --    * The `tltFail` function introduces a test which always fails.+  --      This function is useful in pattern matches, for wholly+  --      unacceptable combinations.+  --+  --    * The `reportAllTestResults` function controls whether TLT+  --      (when invoked with `tlt` as described above) should display+  --      only tests which fails, or should display all passing tests+  --      as well.  The former is the default, since the latter can be+  --      quite verbose.+  --+  --    * The `setExitAfterFailDisplay` function directs `tlt` to exit+  --      after displaying a set of test results which include at *+  --      least one failing test. The idea of this default 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.+  --+  --    * The `inGroup` function groups several tests together as a+  --      single group.  The `tlt` function displays the tests of a+  --      group indented, which helps to visually group related tests+  --      together.+  --+  -- All of these test and option forms are formally documented below.++  -- ** Writing standard assertions++  -- | There are a number of pre-defined forms of assertion imported+  -- automatically from @Test.TLT@.  Note that more operators are in+  -- pairs, with one comparison for monadic results, and one for pure+  -- values.+  --+  -- +-------------------------+---------------------------------------++  -- | `@==`, `@==-`           | Asserts equality of two `Eq` values.  |+  -- +-------------------------+---------------------------------------++  -- | `@/=`, `@/=-`           | Asserts inequality of two `Eq`        |+  -- |                         | values.                               |+  -- +-------------------------+---------------------------------------++  -- | `@<`, `@<-`             | Asserts a less-than relation between  |+  -- |                         | two `Ord` values.                     |+  -- +-------------------------+---------------------------------------++  -- | `@>`, `@>-`             | Asserts a greater-than relation       |+  -- |                         | between two`Ord` values.              |+  -- +-------------------------+---------------------------------------++  -- | `@<=`, `@<=-`           | Asserts a less-than-or-equal-to       |+  -- |                         | relation between two `Ord` values.    |+  -- +-------------------------+---------------------------------------++  -- | `@>=`, `@>=-`           | Asserts a greater-than-or-equal-to    |+  -- |                         | relation between two `Ord` values.    |+  -- +-------------------------+---------------------------------------++  -- | `empty`, `emptyP`       | Asserts the emptiness of a            |+  -- |                         | traversable structure.                |+  -- +-------------------------+---------------------------------------++  -- | `nonempty`, `nonemptyP` | Asserts the non-emptiness of a        |+  -- |                         | traversable structure.                |+  -- +-------------------------+---------------------------------------++  -- + `nothing`, `nothingP`   | Asserts that a `Maybe` value is       |+  -- |                         | `Nothing`.                            |+  -- +-------------------------+---------------------------------------++  --+  -- The predefined operators, along with functions for defining new+  -- `Assertion` operators, are documented more formally below.++  -- ** Dealing with exceptions++  -- | TLT's interaction with exceptions thrown from the `Except`+  -- monad or from an `ExceptT` transformer layer is subtle.  Because+  -- TLT does not have a specification of tests separate from the+  -- tests' execution, TLT will notice test failures only it actually+  -- runs them.  Tests which may be viewed by the human programmer as+  -- implicitly failing because a thrown exception prevented them from+  -- running are __not__ recorded or reported as failures.  TLT+  -- provides three functions for checking for thrown exceptions.  The+  -- first argument of each is a @TLT@ monad of tests which has been+  -- declared to take an `ExceptT` layer.+  --+  --  [`noUncaught`]: Asserts that /no/ uncaught exceptions should be+  --  thrown from its argument computation, and fails if one is.+  --+  --  [`uncaught`]: Asserts that an uncaught exception /should/ be+  --  thrown from its argument computation, and fails if none are+  --  thrown.+  --+  --  [`uncaughtWith`]: Asserts that an uncaught exception /should/ be+  --  thrown from its argument computation, fails if none are thrown,+  --  and passes the thrown exception to its second argument for+  --  further inspection.+  --+  -- The declaration that a monadic value includes an `ExceptT` layer+  -- to be checked is made by declaring instances of the+  -- `MonadTLTExcept` class.  The use of these exception-checking+  -- functions requires that the `TLT` transformer layer be contained+  -- within the `ExceptT` layer.  The generated documentation for this+  -- class and its predefined instances, as well as the above+  -- functions, are all below.+   -- * The TLT transformer-  TLT, tlt, MonadTLT, liftTLT,+  TLT, MonadTLT, liftTLT,   -- ** Session options   reportAllTestResults, setExitAfterFailDisplay,-  -- * Writing tests-  Assertion,-  -- ** `TLT` commands++  -- * Tests   (~:), (~::), (~::-), tltFail, inGroup,-  -- ** Assertions++  -- * Assertions+  Assertion,   -- *** About the values of pure expressions of `Eq`- and `Ord`-type-  (@==),  (@/=),  (@<),  (@>),  (@<=),  (@>=),-  -- *** About monadic computations returing `Eq`s and `Ord`s   (@==-), (@/=-), (@<-), (@>-), (@<=-), (@>=-),+  -- *** About monadic computations returing `Eq`s and `Ord`s+  (@==),  (@/=),  (@<),  (@>),  (@<=),  (@>=),   -- *** About list values   empty, nonempty, emptyP, nonemptyP,   -- *** About `Maybe` values-  nothing, nothingP, assertFailed, assertSuccess,+  nothing, nothingP,+  -- *** Unconditional assertions+  assertFailed, assertSuccess,+   -- ** Building new assertions   -- *** Unary assertions   liftAssertionPure, assertionPtoM, liftAssertionM,   -- *** Binary assertions-  liftAssertion2Pure, assertion2PtoM, liftAssertion2M+  liftAssertion2Pure, assertion2PtoM, liftAssertion2M,+  -- * Dealing with exceptions in an `ExceptT` layer+  MonadTLTExcept, liftTLTExcept, runToExcept,+  noUncaught, uncaught, uncaughtWith    ) where @@ -61,3 +208,4 @@ import Test.TLT.Report import Test.TLT.Assertion import Test.TLT.Standard+import Control.Monad.Trans.Except -- For Haddock links

@@ -15,15 +15,18 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Test.TLT.Class where  import Control.Exception import Control.Monad+import Control.Monad.Except import Control.Monad.ST.Trans import Control.Monad.Trans.Class -- import Control.Monad.Trans.Either+import Control.Monad.Trans.Except import Control.Monad.Trans.Free import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe@@ -42,7 +45,7 @@  -- |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 }+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@@ -78,6 +81,9 @@ instance MonadTLT m n => MonadTLT (StateT s m) n where   liftTLT = lift . liftTLT +instance MonadTLT m n => MonadTLT (ExceptT e m) n where+  liftTLT = lift . liftTLT+ instance MonadTLT m n => MonadTLT (SL.StateT s m) n where   liftTLT = lift . liftTLT @@ -90,6 +96,82 @@ instance (MonadTLT m n, Monoid w) => MonadTLT (WS.WriterT w m) n where   liftTLT = lift . liftTLT +{- --------------------------------------------------------------- -}++-- | Enabling TLT checking of the completion of computations with- or+-- without uncaught exceptions in a (possibly embedded) `ExceptT` or+-- `Except` monad.+--+-- In general, it is more difficult to automatically deduce+-- @MonadTLTExcept@ instances than @MonadTLT@ because `runToExcept`+-- instances bodies will frequently require additional parameters to+-- functions such as `runReaderT`, or values corresponding to+-- `Nothing`, which are specific to a particular scenario.+--+-- Note that using @MonadTLTExcept@ imposes the restriction that the+-- `TLT` transformer layer must be wrapped within the `ExceptT`+-- transformer layer.+class (MonadTLT m nt, Monad m, MonadTLT ne nt) => MonadTLTExcept m e nt ne+      | m -> e, m -> ne where+  liftTLTExcept :: ExceptT e ne a -> m a+  runToExcept :: m a -> ExceptT e ne a++instance MonadTLT m nt => MonadTLTExcept (ExceptT e m) e nt m where+  liftTLTExcept = id+  runToExcept = id++{-+-- I don't understand the FreeT transformer well enough to build this.+instance (MonadTLTExcept m e nt ne, Functor f) =>+         MonadTLTExcept (FreeT f m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept+  runToExcept = ???+-}++instance MonadTLTExcept m e nt ne => MonadTLTExcept (IdentityT m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept+  runToExcept = runToExcept . runIdentityT++{-+instance (MonadTLTExcept m e nt ne) =>+         MonadTLTExcept (MaybeT m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept+  runToExcept m = runToExcept $ do res <- runMaybeT m+                                   case res of+                                     Nothing -> return "???"+                                     Just j -> return j++instance MonadTLTExcept m e nt ne => MonadTLTExcept (ReaderT r m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept++instance MonadTLTExcept m e nt ne => MonadTLTExcept (ResourceT m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept++instance MonadTLTExcept m e nt ne =>+         MonadTLTExcept (SL.StateT s m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept++instance MonadTLTExcept m e nt ne => MonadTLTExcept (STT s m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept+  runToExcept = runToExcept . runSTT+-}++-- | The `runToExcept` function in this case simply discards any+-- output.+instance (MonadTLTExcept m e nt ne, Monoid w) =>+         MonadTLTExcept (WL.WriterT w m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept+  runToExcept m = runToExcept $ do (res, _) <- WL.runWriterT m+                                   return res++-- | The `runToExcept` function in this case simply discards any+-- output.+instance (MonadTLTExcept m e nt ne, Monoid w) =>+         MonadTLTExcept (WS.WriterT w m) e nt ne where+  liftTLTExcept = lift . liftTLTExcept+  runToExcept m = runToExcept $ do (res, _) <- WS.runWriterT m+                                   return res+ -- |Execute the tests specified in a `TLT` monad without output -- side-effects, returning the final options and result reports. --@@ -130,6 +212,13 @@   let after = addResult before $ Test desc [Asserted detail]   put (opts, after) +-- |Report a success.  Useful in default cases.+tltPass :: MonadTLT m n => String -> m ()+tltPass desc = liftTLT $ TLT $ do+  (opts, before) <- get+  let after = addResult before $ Test desc []+  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@@ -140,3 +229,26 @@   (opts', after) <- liftTLT $ TLT $ get   liftTLT $ TLT $ put $ (opts', popGroup after)   return result++-- | Ensure that a computation in `ExceptT` completes without an+-- uncaught exception.+noUncaught :: MonadTLTExcept m e nt ne => String -> m a -> m ()+noUncaught loc m = do+  let label = "No uncaught exception from " ++ loc+  liftTLTExcept $ catchE (do runToExcept m+                             tltPass label)+                         (\_ -> label `tltFail` "Uncaught exception")++-- | Ensure that a computation in `ExceptT` does throw an uncaught+-- exception, allowing further testing of the exception.+uncaughtWith ::+  (MonadTLTExcept m e nt ne) => String -> m a -> (e -> ExceptT e ne ()) -> m ()+uncaughtWith loc m handler =+  liftTLTExcept $ catchE (do runToExcept m+                             ("Expected uncaught exception from " ++ loc)+                               `tltFail` "Did not throw exception")+                         handler++-- | Ensure that a computation in `ExceptT` does throw an uncaught+-- exception.+uncaught loc m = uncaughtWith loc m $ \_ -> return ()

@@ -15,6 +15,7 @@ module Test.TLT.Standard where import Data.Maybe import Test.TLT.Assertion+import Control.Monad.Trans.Except  infix 1 @==,  @/=,  @<,  @>,  @<=,  @>= infix 1 @==-, @/=-, @<-, @>-, @<=-, @>=-

@@ -4,13 +4,16 @@ {-# LANGUAGE UndecidableInstances #-}  import Test.TLT+import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans+import Control.Monad  main :: IO () main = do   tlt test   tlt ttest+  tlt $ runExceptT extest  test :: Monad m => TLT m () test = do@@ -82,3 +85,18 @@   "5 is 5 as pure assertion" ~: 5 @==- 5   "6 is 6 as pure assertion" ~: 6 @==- 6 +extest :: ExceptT String (TLT IO) ()+extest = do+  noUncaught "extest1" $ do+    "6 is 6 as pure assertion" ~: 6 @==- 6+    "7 is 7 as pure assertion" ~: 7 @==- 7+  uncaught "extest2" $ do+    "8 is 8 as pure assertion" ~: 8 @==- 8+    throwE "Boom"+    "9 is 9 as pure assertion" ~: 9 @==- 9+  uncaughtWith "extest3" (do "10 is 10 as pure assertion" ~: 10 @==- 10+                             throwE "Boom"+                             "11 is 11 as pure assertion" ~: 11 @==- 11) h++  where h :: String -> ExceptT String (TLT IO) ()+        h e = "The exception should be \"Boom\"" ~: "Boom" @==- e