use Either rather than throwing an exception
This commit is contained in:
parent
62961ef931
commit
29c335af56
@ -700,18 +700,18 @@ get url = request $ do
|
|||||||
--
|
--
|
||||||
-- > followRedirect
|
-- > followRedirect
|
||||||
followRedirect :: Yesod site
|
followRedirect :: Yesod site
|
||||||
=> YesodExample site ()
|
=> YesodExample site (Either T.Text ())
|
||||||
followRedirect = do
|
followRedirect = do
|
||||||
mr <- getResponse
|
mr <- getResponse
|
||||||
case mr of
|
case mr of
|
||||||
Nothing -> failure "no response, so no redirect to follow"
|
Nothing -> return $ Left "no response, so no redirect to follow"
|
||||||
Just r -> do
|
Just r -> do
|
||||||
if not ((H.statusCode $ simpleStatus r) `elem` [301,303])
|
if not ((H.statusCode $ simpleStatus r) `elem` [301,303])
|
||||||
then failure "followRedirect called, but previous request was not a redirect"
|
then return $ Left "followRedirect called, but previous request was not a redirect"
|
||||||
else do
|
else do
|
||||||
case lookup "Location" (simpleHeaders r) of
|
case lookup "Location" (simpleHeaders r) of
|
||||||
Nothing -> failure "No location header set"
|
Nothing -> return $ Left "No location header set"
|
||||||
Just h -> get (TE.decodeUtf8 h)
|
Just h -> get (TE.decodeUtf8 h) >> return (Right ())
|
||||||
|
|
||||||
-- | Sets the HTTP method used by the request.
|
-- | Sets the HTTP method used by the request.
|
||||||
--
|
--
|
||||||
|
|||||||
@ -231,13 +231,10 @@ main = hspec $ do
|
|||||||
bodyContains "we have been successfully redirected"
|
bodyContains "we have been successfully redirected"
|
||||||
|
|
||||||
|
|
||||||
yit "throws an exception when no redirect was returned" $ do
|
yit "returns a Left when no redirect was returned" $ do
|
||||||
get ("/" :: Text)
|
get ("/" :: Text)
|
||||||
statusIs 200
|
statusIs 200
|
||||||
-- This appears to be an HUnitFailure, which is not
|
r <- followRedirect
|
||||||
-- exported, so I'm catching SomeException instead.
|
|
||||||
(r :: Either SomeException ()) <- try followRedirect
|
|
||||||
statusIs 200
|
|
||||||
liftIO $ assertBool "expected exception" $ isLeft r
|
liftIO $ assertBool "expected exception" $ isLeft r
|
||||||
|
|
||||||
instance RenderMessage LiteApp FormMessage where
|
instance RenderMessage LiteApp FormMessage where
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user