Distilled ErrorHandling bug to simple catchIter bug
This commit is contained in:
parent
35274e4859
commit
f5b5dc9b10
@ -164,6 +164,7 @@ import Data.Text (Text)
|
|||||||
import Yesod.Message (RenderMessage (..))
|
import Yesod.Message (RenderMessage (..))
|
||||||
|
|
||||||
import Text.Blaze (toHtml, preEscapedText)
|
import Text.Blaze (toHtml, preEscapedText)
|
||||||
|
import Yesod.Internal.TestApi (catchIter)
|
||||||
|
|
||||||
-- | The type-safe URLs associated with a site argument.
|
-- | The type-safe URLs associated with a site argument.
|
||||||
type family Route a
|
type family Route a
|
||||||
@ -420,12 +421,6 @@ runHandler handler mrender sroute tomr ma sa =
|
|||||||
finalSession
|
finalSession
|
||||||
HCWai r -> return $ YARWai r
|
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 :: ErrorResponse -> YesodApp
|
||||||
safeEh er = YesodApp $ \_ _ _ session -> do
|
safeEh er = YesodApp $ \_ _ _ session -> do
|
||||||
liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
|
liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
|
||||||
|
|||||||
@ -6,6 +6,17 @@
|
|||||||
--
|
--
|
||||||
module Yesod.Internal.TestApi
|
module Yesod.Internal.TestApi
|
||||||
( randomString, parseWaiRequest'
|
( randomString, parseWaiRequest'
|
||||||
|
, catchIter
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Yesod.Internal.Request (randomString, parseWaiRequest')
|
import Yesod.Internal.Request (randomString, parseWaiRequest')
|
||||||
|
import Control.Exception (Exception, catch)
|
||||||
|
import Data.Enumerator (Iteratee (..))
|
||||||
|
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 $ mstep `catch` (runIteratee . f)
|
||||||
|
|||||||
@ -11,6 +11,10 @@ import Network.Wai.Test
|
|||||||
import Text.Hamlet (hamlet)
|
import Text.Hamlet (hamlet)
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.ByteString.Char8 as S8
|
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
|
data App = App
|
||||||
|
|
||||||
@ -57,6 +61,7 @@ errorHandlingTest = describe "Test.ErrorHandling"
|
|||||||
[ it "says not found" caseNotFound
|
[ it "says not found" caseNotFound
|
||||||
, it "says 'There was an error' before runRequestBody" caseBefore
|
, it "says 'There was an error' before runRequestBody" caseBefore
|
||||||
, it "says 'There was an error' after runRequestBody" caseAfter
|
, it "says 'There was an error' after runRequestBody" caseAfter
|
||||||
|
, it "catchIter handles internal exceptions" caseCatchIter
|
||||||
]
|
]
|
||||||
|
|
||||||
runner :: Session () -> IO ()
|
runner :: Session () -> IO ()
|
||||||
@ -96,3 +101,11 @@ caseAfter = runner $ do
|
|||||||
}
|
}
|
||||||
assertStatus 500 res
|
assertStatus 500 res
|
||||||
assertBodyContains "There was an error 2.71828" res
|
assertBodyContains "There was an error 2.71828" 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 ()
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user