Permalink
Browse files

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

  • Loading branch information...
1 parent 22ff85f commit 067da19a6b9455da034e6507948a578e7169461f @adinapoli adinapoli committed Nov 5, 2013
Showing with 40 additions and 30 deletions.
  1. +25 −15 src/Snap/Snaplet/Test.hs
  2. +15 −15 test/snap-testsuite.cabal
@@ -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
@@ -50,6 +51,27 @@ removeFileMayNotExist f = catchNonExistence (removeFile f) ()
------------------------------------------------------------------------------
+-- | 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
------------------------------------------------------------------------------
@@ -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,

0 comments on commit 067da19

Please sign in to comment.