test result value, return URL in Right branch, document meaning in haddocks

This commit is contained in:
Mark Wotton 2016-03-21 17:16:28 -04:00
parent 92f24a73dc
commit ef00ddd80b
2 changed files with 12 additions and 6 deletions

View File

@ -695,12 +695,15 @@ get url = request $ do
setUrl url setUrl url
-- | Follow a redirect, if the last response was a redirect. -- | Follow a redirect, if the last response was a redirect.
-- | Return Left with an error message if not a redirect
-- | Return Right with the redirected URL if it was.
--
-- ==== __Examples__ -- ==== __Examples__
-- > get HomeR -- > get HomeR
-- --
-- > followRedirect -- > followRedirect
followRedirect :: Yesod site followRedirect :: Yesod site
=> YesodExample site (Either T.Text ()) => YesodExample site (Either T.Text T.Text)
followRedirect = do followRedirect = do
mr <- getResponse mr <- getResponse
case mr of case mr of
@ -711,7 +714,8 @@ followRedirect = do
else do else do
case lookup "Location" (simpleHeaders r) of case lookup "Location" (simpleHeaders r) of
Nothing -> return $ Left "followRedirect called, but no location header set" Nothing -> return $ Left "followRedirect called, but no location header set"
Just h -> get (TE.decodeUtf8 h) >> return (Right ()) Just h -> let url = TE.decodeUtf8 h in
get url >> return (Right url)
-- | Sets the HTTP method used by the request. -- | Sets the HTTP method used by the request.
-- --

View File

@ -20,7 +20,7 @@ import Data.Monoid ((<>))
import Control.Applicative import Control.Applicative
import Network.Wai (pathInfo, requestHeaders) import Network.Wai (pathInfo, requestHeaders)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Either (isLeft) import Data.Either (isLeft, isRight)
import Control.Exception.Lifted(try, SomeException) import Control.Exception.Lifted(try, SomeException)
import Data.ByteString.Lazy.Char8 () import Data.ByteString.Lazy.Char8 ()
@ -219,14 +219,16 @@ main = hspec $ do
yit "follows 303 redirects when requested" $ do yit "follows 303 redirects when requested" $ do
get ("/redirect303" :: Text) get ("/redirect303" :: Text)
statusIs 303 statusIs 303
followRedirect r <- followRedirect
liftIO $ assertBool "expected a Right from a 303 redirect" $ isRight r
statusIs 200 statusIs 200
bodyContains "we have been successfully redirected" bodyContains "we have been successfully redirected"
yit "follows 301 redirects when requested" $ do yit "follows 301 redirects when requested" $ do
get ("/redirect301" :: Text) get ("/redirect301" :: Text)
statusIs 301 statusIs 301
followRedirect r <- followRedirect
liftIO $ assertBool "expected a Right from a 301 redirect" $ isRight r
statusIs 200 statusIs 200
bodyContains "we have been successfully redirected" bodyContains "we have been successfully redirected"
@ -235,7 +237,7 @@ main = hspec $ do
get ("/" :: Text) get ("/" :: Text)
statusIs 200 statusIs 200
r <- followRedirect r <- followRedirect
liftIO $ assertBool "expected exception" $ isLeft r liftIO $ assertBool "expected a Left when not a redirect" $ isLeft r
instance RenderMessage LiteApp FormMessage where instance RenderMessage LiteApp FormMessage where
renderMessage _ _ = defaultFormMessage renderMessage _ _ = defaultFormMessage