Fixed bug in evalHandler/runHandler: now we run the cleanup action

src/Snap/Snaplet/Test.hs

@@ -16,6 +16,7 @@ import           Control.Exception.Base (finally)
 import qualified Control.Exception as E
 import           Control.Monad.IO.Class
 import           Data.Maybe (fromMaybe) 
+import           Data.IORef
 import           Data.Text
 import           System.Directory
 import           System.IO.Error
@@ -49,6 +50,27 @@ removeFileMayNotExist f = catchNonExistence (removeFile f) ()
                                       else ioError e
 
 
+------------------------------------------------------------------------------
+-- | Helper to keep "runHandler" and "evalHandler" DRY.
+execHandlerComputation :: MonadIO m 
+                       => (RequestBuilder m () -> Snap v -> m a)
+                       -> Maybe String
+                       -> RequestBuilder m ()
+                       -> Handler b b v
+                       -> SnapletInit b b
+                       -> m (Either Text a)
+execHandlerComputation f env rq h s = do
+    app <- getSnaplet env s
+    case app of
+      (Left e) -> return $ Left e
+      (Right (a, is)) -> do
+          res <- f rq $ runPureBase h a
+          -- Run the cleanup action
+          liftIO $ do
+              cleanupAction <- readIORef $ _cleanup is
+              cleanupAction
+          return $ Right res
+
 ------------------------------------------------------------------------------
 -- | Given a Snaplet Handler and a 'RequestBuilder' defining
 -- a test request, runs the Handler, producing an HTTP 'Response'.
@@ -59,16 +81,10 @@ removeFileMayNotExist f = catchNonExistence (removeFile f) ()
 runHandler :: MonadIO m
            => Maybe String
            -> RequestBuilder m ()
-           -> Handler b b a
+           -> Handler b b v
            -> SnapletInit b b
            -> m (Either Text Response)
-runHandler env rq h s = do
-        app <- getSnaplet env s
-        case app of
-          (Left e) -> return $ Left e
-          (Right (a,_)) -> do
-              res <- ST.runHandler rq $ runPureBase h a
-              return $ Right res
+runHandler = execHandlerComputation ST.runHandler
 
 
 ------------------------------------------------------------------------------
@@ -88,13 +104,7 @@ evalHandler :: MonadIO m
             -> Handler b b a
             -> SnapletInit b b
             -> m (Either Text a)
-evalHandler env rq h s = do
-    app <- getSnaplet env s
-    case app of
-      (Left e) -> return $ Left e
-      (Right (a,_)) -> do
-          res <- ST.evalHandler rq $ runPureBase h a
-          return $ Right res
+evalHandler = execHandlerComputation ST.evalHandler
 
 
 ------------------------------------------------------------------------------

test/snap-testsuite.cabal

@@ -16,13 +16,13 @@ Executable snap-testsuite
     HUnit                      >= 1.2      && < 2,
     QuickCheck                 >= 2.3.0.2,
     blaze-builder              >= 0.3      && < 0.4,
-    http-streams               >= 0.4.0.1  && < 0.5,
+    http-streams               >= 0.4.0.1  && < 0.8,
     process                    == 1.*,
-    smallcheck                 >= 0.6      && < 0.7,
-    test-framework             >= 0.6      && < 0.7,
-    test-framework-hunit       >= 0.2.7    && < 0.3,
-    test-framework-quickcheck2 >= 0.2.12.1 && < 0.3,
-    test-framework-smallcheck  >= 0.1      && < 0.2,
+    smallcheck                 >= 0.6      && < 1.1,
+    test-framework             >= 0.6      && < 0.9,
+    test-framework-hunit       >= 0.2.7    && < 0.4,
+    test-framework-quickcheck2 >= 0.2.12.1 && < 0.4,
+    test-framework-smallcheck  >= 0.1      && < 0.3,
     unix                       >= 2.2.0.0  && < 2.7,
 
     MonadCatchIO-transformers  >= 0.2      && < 0.4,
@@ -42,7 +42,7 @@ Executable snap-testsuite
     -- Blacklist bad versions of hashable
     hashable                  (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),
     heist                      >= 0.13     && < 0.14,
-    logict                     >= 0.4.2    && < 0.6,
+    logict                     >= 0.4.2    && < 0.7,
     mtl                        >  2.0      && < 2.2,
     mwc-random                 >= 0.8      && < 0.14,
     pwstore-fast               >= 2.2      && < 2.5,
@@ -114,7 +114,7 @@ Executable app
     -- Blacklist bad versions of hashable
     hashable                  (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),
     heist                      >= 0.13     && < 0.14,
-    logict                     >= 0.4.2    && < 0.6,
+    logict                     >= 0.4.2    && < 0.7,
     mtl                        >  2.0      && < 2.2,
     mwc-random                 >= 0.8      && < 0.14,
     pwstore-fast               >= 2.2      && < 2.5,
@@ -170,13 +170,13 @@ Executable nesttest
     Glob                       >= 0.5      && < 0.8,
     HUnit                      >= 1.2      && < 2,
     QuickCheck                 >= 2.3.0.2,
-    http-streams               >= 0.4.0.1  && < 0.5,
+    http-streams               >= 0.4.0.1  && < 0.8,
     process                    == 1.*,
-    smallcheck                 >= 0.6      && < 0.7,
-    test-framework             >= 0.6      && < 0.7,
-    test-framework-hunit       >= 0.2.7    && < 0.3,
-    test-framework-quickcheck2 >= 0.2.12.1 && < 0.3,
-    test-framework-smallcheck  >= 0.1      && < 0.2,
+    smallcheck                 >= 0.6      && < 1.1,
+    test-framework             >= 0.6      && < 0.9,
+    test-framework-hunit       >= 0.2.7    && < 0.4,
+    test-framework-quickcheck2 >= 0.2.12.1 && < 0.4,
+    test-framework-smallcheck  >= 0.1      && < 0.3,
     unix                       >= 2.2.0.0  && < 2.7,
 
     MonadCatchIO-transformers  >= 0.2      && < 0.4,
@@ -196,7 +196,7 @@ Executable nesttest
     -- Blacklist bad versions of hashable
     hashable                  (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),
     heist                      >= 0.13     && < 0.14,
-    logict                     >= 0.4.2    && < 0.6,
+    logict                     >= 0.4.2    && < 0.7,
     mtl                        >  2.0      && < 2.2,
     mwc-random                 >= 0.8      && < 0.14,
     pwstore-fast               >= 2.2      && < 2.5,