diff --git a/src/Test/TLT/Assertion.hs b/src/Test/TLT/Assertion.hs index 762780f..a3af512 100644 --- a/src/Test/TLT/Assertion.hs +++ b/src/Test/TLT/Assertion.hs @@ -49,8 +49,12 @@ infix 0 ~:, ~::, ~::- -- > "2 not 3" ~: 2 @/=- 3 -- This test fails. (~:) :: forall m n . MonadTLT m n => String -> Assertion m -> m () s ~: a = do - state <- liftTLT $ TLT $ get - assessment <- a + state <- liftTLT $ TLT get + {- + let -- interceptor :: m [TestFail] -> m [TestFail] + interceptor = tltStateInterceptor state + -} + assessment <- {- interceptor -} a liftTLT $ TLT $ put $ state { tltStateAccum = addResult (tltStateAccum state) $ diff --git a/src/Test/TLT/Class.hs b/src/Test/TLT/Class.hs index 197a96a..347cb56 100644 --- a/src/Test/TLT/Class.hs +++ b/src/Test/TLT/Class.hs @@ -13,6 +13,7 @@ Main state and monad definitions for the @TLT@ testing system. See -} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-} @@ -53,7 +54,7 @@ interceptNothing = id data TLTstate (m :: Type -> Type) = TLTstate { tltStateOptions :: TLTopts, tltStateAccum :: TRBuf, - tltInterceptor :: Interceptor m + tltStateInterceptor :: Interceptor m } -- |Monad transformer for TLT tests. This layer stores the results @@ -127,7 +128,7 @@ runTLT (TLT t) = do (_, state) <- runStateT t $ TLTstate { tltStateOptions = defaultOpts, tltStateAccum = Top 0 0 [], - tltInterceptor = interceptNothing + tltStateInterceptor = interceptNothing } return (tltStateOptions state, closeTRBuf $ tltStateAccum state) @@ -184,15 +185,15 @@ inGroup name group = do -- | Call prior to a series of TLT tests to detect general errors. -- Requires that the underlying computation be `MonadIO`. withIOErrorsByTLT :: - (MonadTLT m n, MonadIO n) => (n [TestFail] -> IO [TestFail]) -> m () -withIOErrorsByTLT runner = liftTLT $ TLT $ do + MonadIO m => (m [TestFail] -> IO [TestFail]) -> TLT m () +withIOErrorsByTLT runner = TLT $ do state <- get - put $ state { tltInterceptor = interceptExceptions runner } + put $ state { tltStateInterceptor = interceptExceptions runner } -- | Call prior to a series of TLT tests to detect general errors. -- Requires that the underlying computation be `MonadIO`. interceptExceptions :: - (MonadIO m) => (m [TestFail] -> IO [TestFail]) -> Interceptor m + MonadIO m => (m [TestFail] -> IO [TestFail]) -> Interceptor m interceptExceptions runner a = liftIO $ catch (runner a) $ \e -> return $ [Erred $ show $ (e :: SomeException)]