yesod-core 0.9.3.1 → 0.9.3.2
raw patch · 5 files changed
+135/−10 lines, 5 filesdep ~enumeratordep ~hspecdep ~wai-testPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: enumerator, hspec, wai-test
API changes (from Hackage documentation)
+ Yesod.Internal.TestApi: catchIter :: Exception e => Iteratee ByteString IO a -> (e -> Iteratee ByteString IO a) -> Iteratee ByteString IO a
Files
- Yesod/Handler.hs +1/−7
- Yesod/Internal/TestApi.hs +16/−0
- test/Test/ErrorHandling.hs +111/−0
- test/main.hs +2/−0
- yesod-core.cabal +5/−3
Yesod/Handler.hs view
@@ -119,7 +119,6 @@ import Data.Time (UTCTime) import Control.Exception hiding (Handler, catch, finally)-import qualified Control.Exception as E import Control.Applicative import Control.Monad (liftM, join, MonadPlus)@@ -164,6 +163,7 @@ import Yesod.Message (RenderMessage (..)) import Text.Blaze (toHtml, preEscapedText)+import Yesod.Internal.TestApi (catchIter) -- | The type-safe URLs associated with a site argument. type family Route a@@ -419,12 +419,6 @@ emptyContent finalSession HCWai r -> return $ YARWai r--catchIter :: Exception e- => Iteratee ByteString IO a- -> (e -> Iteratee ByteString IO a)- -> Iteratee ByteString IO a-catchIter (Iteratee mstep) f = Iteratee $ mstep `E.catch` (runIteratee . f) safeEh :: ErrorResponse -> YesodApp safeEh er = YesodApp $ \_ _ _ session -> do
Yesod/Internal/TestApi.hs view
@@ -6,6 +6,22 @@ -- module Yesod.Internal.TestApi ( randomString, parseWaiRequest'+ , catchIter ) where import Yesod.Internal.Request (randomString, parseWaiRequest')+import Control.Exception (Exception, catch)+import Data.Enumerator (Iteratee (..), Step (..))+import Data.ByteString (ByteString)+import Prelude hiding (catch)++catchIter :: Exception e+ => Iteratee ByteString IO a+ -> (e -> Iteratee ByteString IO a)+ -> Iteratee ByteString IO a+catchIter (Iteratee mstep) f = Iteratee $ do+ step <- mstep `catch` (runIteratee . f)+ return $ case step of+ Continue k -> Continue $ \s -> catchIter (k s) f+ Yield b s -> Yield b s+ Error e -> Error e
+ test/Test/ErrorHandling.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}+module Test.ErrorHandling+ ( errorHandlingTest+ , Widget+ ) where+import Yesod.Core+import Test.Hspec+import Test.Hspec.HUnit()+import Network.Wai+import Network.Wai.Test+import Text.Hamlet (hamlet)+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as S8+import Yesod.Internal.TestApi+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL+import Control.Exception (SomeException)++data App = App++mkYesod "App" [parseRoutes|+/ HomeR GET+/not_found NotFoundR POST+/first_thing FirstThingR POST+/after_runRequestBody AfterRunRequestBodyR POST+|]++instance Yesod App where approot _ = ""++getHomeR :: Handler RepHtml+getHomeR = defaultLayout $ toWidget [hamlet|+!!!++<html>+ <body>+ <form method=post action=@{NotFoundR}>+ <input type=submit value="Not found">+ <form method=post action=@{FirstThingR}>+ <input type=submit value="Error is thrown first thing in handler">+ <form method=post action=@{AfterRunRequestBodyR}>+ <input type=submit value="BUGGY: Error thrown after runRequestBody">+|]++postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler RepHtml+postNotFoundR = do+ (_, _files) <- runRequestBody+ _ <- notFound+ getHomeR++postFirstThingR = do+ _ <- error "There was an error 3.14159"+ getHomeR++postAfterRunRequestBodyR = do+ x <- runRequestBody+ _ <- error $ show x+ getHomeR++errorHandlingTest :: [Spec]+errorHandlingTest = describe "Test.ErrorHandling"+ [ it "says not found" caseNotFound+ , it "says 'There was an error' before runRequestBody" caseBefore+ , it "says 'There was an error' after runRequestBody" caseAfter+ , it "catchIter handles internal exceptions" caseCatchIter+ ]++runner :: Session () -> IO ()+runner f = toWaiApp App >>= runSession f++caseNotFound :: IO ()+caseNotFound = runner $ do+ res <- request defaultRequest+ { pathInfo = ["not_found"]+ , requestMethod = "POST"+ }+ assertStatus 404 res+ assertBodyContains "Not Found" res++caseBefore :: IO ()+caseBefore = runner $ do+ res <- request defaultRequest+ { pathInfo = ["first_thing"]+ , requestMethod = "POST"+ }+ assertStatus 500 res+ assertBodyContains "There was an error 3.14159" res++caseAfter :: IO ()+caseAfter = runner $ do+ let content = "foo=bar&baz=bin12345"+ res <- srequest SRequest+ { simpleRequest = defaultRequest+ { pathInfo = ["after_runRequestBody"]+ , requestMethod = "POST"+ , requestHeaders =+ [ ("content-type", "application/x-www-form-urlencoded")+ , ("content-length", S8.pack $ show $ L.length content)+ ]+ }+ , simpleRequestBody = content+ }+ assertStatus 500 res+ assertBodyContains "bin12345" res++caseCatchIter :: IO ()+caseCatchIter = E.run_ $ E.enumList 8 (replicate 1000 "foo") E.$$ flip catchIter ignorer $ do+ _ <- EL.consume+ error "foo"+ where+ ignorer :: SomeException -> E.Iteratee a IO ()+ ignorer _ = return ()
test/main.hs view
@@ -7,6 +7,7 @@ import Test.Links import Test.NoOverloadedStrings import Test.InternalRequest+import Test.ErrorHandling main :: IO () main = hspecX $ descriptions $@@ -17,4 +18,5 @@ , linksTest , noOverloadedTest , internalRequestTest+ , errorHandlingTest ]
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 0.9.3.1+version: 0.9.3.2 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -23,6 +23,7 @@ test/Test/CleanPath.hs test/Test/Links.hs test/Test/InternalRequest.hs+ test/Test/ErrorHandling.hs test/main.hs flag test@@ -107,8 +108,8 @@ build-depends: base >= 4 && < 4.3 main-is: main.hs cpp-options: -DTEST- build-depends: hspec >= 0.8 && < 0.9- ,wai-test+ build-depends: hspec >= 0.8 && < 0.10+ ,wai-test >= 0.1.2 && < 0.2 ,wai ,yesod-core ,bytestring@@ -120,6 +121,7 @@ , random ,HUnit ,QuickCheck >= 2 && < 3+ , enumerator ghc-options: -Wall source-repository head