diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index 032be807..de377caf 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-test +## 1.6.11 + +* Add missing `HasCallStack`s [#1710](https://github.com/yesodweb/yesod/pull/1710) + ## 1.6.10 * `statusIs` assertion failures now print a preview of the response body, if the response body is UTF-8 or ASCII. [#1680](https://github.com/yesodweb/yesod/pull/1680/files) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 6c319234..026eb61b 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -500,7 +500,8 @@ testClearCookies = do -- Performs a given action using the last response. Use this to create -- response-level assertions -withResponse' :: (state -> Maybe SResponse) +withResponse' :: HasCallStack + => (state -> Maybe SResponse) -> [T.Text] -> (SResponse -> SIO state a) -> SIO state a @@ -514,7 +515,7 @@ withResponse' getter errTrace f = maybe err f . getter =<< getSIO -- | Performs a given action using the last response. Use this to create -- response-level assertions -withResponse :: (SResponse -> YesodExample site a) -> YesodExample site a +withResponse :: HasCallStack => (SResponse -> YesodExample site a) -> YesodExample site a withResponse = withResponse' yedResponse [] -- | Use HXT to parse a value from an HTML tag. @@ -523,7 +524,8 @@ parseHTML :: HtmlLBS -> Cursor parseHTML html = fromDocument $ HD.parseLBS html -- | Query the last response using CSS selectors, returns a list of matched fragments -htmlQuery' :: (state -> Maybe SResponse) +htmlQuery' :: HasCallStack + => (state -> Maybe SResponse) -> [T.Text] -> Query -> SIO state [HtmlLBS] @@ -533,7 +535,7 @@ htmlQuery' getter errTrace query = withResponse' getter ("Tried to invoke htmlQu Right matches -> return $ map (encodeUtf8 . TL.pack) matches -- | Query the last response using CSS selectors, returns a list of matched fragments -htmlQuery :: Query -> YesodExample site [HtmlLBS] +htmlQuery :: HasCallStack => Query -> YesodExample site [HtmlLBS] htmlQuery = htmlQuery' yedResponse [] -- | Asserts that the two given values are equal. @@ -803,7 +805,7 @@ printBody = withResponse $ \ SResponse { simpleBody = b } -> -- > {-# LANGUAGE OverloadedStrings #-} -- > get HomeR -- > printMatches "h1" -- Prints all h1 tags -printMatches :: Query -> YesodExample site () +printMatches :: HasCallStack => Query -> YesodExample site () printMatches query = do matches <- htmlQuery query liftIO $ hPutStrLn stderr $ show matches @@ -863,7 +865,7 @@ addFile name path mimetype = do -- | -- This looks up the name of a field based on the contents of the label pointing to it. -genericNameFromLabel :: (T.Text -> T.Text -> Bool) -> T.Text -> RequestBuilder site T.Text +genericNameFromLabel :: HasCallStack => (T.Text -> T.Text -> Bool) -> T.Text -> RequestBuilder site T.Text genericNameFromLabel match label = do mres <- fmap rbdResponse getSIO res <- @@ -1135,7 +1137,7 @@ fileByLabelSuffix = fileByLabelWithMatch T.isSuffixOf -- -- > request $ do -- > addToken_ "#formID" -addToken_ :: Query -> RequestBuilder site () +addToken_ :: HasCallStack => Query -> RequestBuilder site () addToken_ scope = do matches <- htmlQuery' rbdResponse ["Tried to get CSRF token with addToken'"] $ scope <> " input[name=_token][type=hidden][value]" case matches of @@ -1149,7 +1151,7 @@ addToken_ scope = do -- -- > request $ do -- > addToken -addToken :: RequestBuilder site () +addToken :: HasCallStack => RequestBuilder site () addToken = addToken_ "" -- | Calls 'addTokenFromCookieNamedToHeaderNamed' with the 'defaultCsrfCookieName' and 'defaultCsrfHeaderName'. @@ -1162,7 +1164,7 @@ addToken = addToken_ "" -- > addTokenFromCookie -- -- Since 1.4.3.2 -addTokenFromCookie :: RequestBuilder site () +addTokenFromCookie :: HasCallStack => RequestBuilder site () addTokenFromCookie = addTokenFromCookieNamedToHeaderNamed defaultCsrfCookieName defaultCsrfHeaderName -- | Looks up the CSRF token stored in the cookie with the given name and adds it to the request headers. An error is thrown if the cookie can't be found. @@ -1178,7 +1180,8 @@ addTokenFromCookie = addTokenFromCookieNamedToHeaderNamed defaultCsrfCookieName -- > addTokenFromCookieNamedToHeaderNamed "cookieName" (CI "headerName") -- -- Since 1.4.3.2 -addTokenFromCookieNamedToHeaderNamed :: ByteString -- ^ The name of the cookie +addTokenFromCookieNamedToHeaderNamed :: HasCallStack + => ByteString -- ^ The name of the cookie -> CI ByteString -- ^ The name of the header -> RequestBuilder site () addTokenFromCookieNamedToHeaderNamed cookieName headerName = do @@ -1201,7 +1204,7 @@ addTokenFromCookieNamedToHeaderNamed cookieName headerName = do -- > liftIO $ putStrLn $ "Cookies are: " ++ show cookies -- -- Since 1.4.3.2 -getRequestCookies :: RequestBuilder site Cookies +getRequestCookies :: HasCallStack => RequestBuilder site Cookies getRequestCookies = do requestBuilderData <- getSIO headers <- case simpleHeaders Control.Applicative.<$> rbdResponse requestBuilderData of @@ -1363,7 +1366,7 @@ setUrl url' = do -- > clickOn "a#idofthelink" -- -- @since 1.5.7 -clickOn :: Yesod site => Query -> YesodExample site () +clickOn :: (HasCallStack, Yesod site) => Query -> YesodExample site () clickOn query = do withResponse' yedResponse ["Tried to invoke clickOn in order to read HTML of a previous response."] $ \ res -> case findAttributeBySelector (simpleBody res) query "href" of @@ -1567,7 +1570,7 @@ parseSetCookies :: [H.Header] -> [Cookie.SetCookie] parseSetCookies headers = map (Cookie.parseSetCookie . snd) $ DL.filter (("Set-Cookie"==) . fst) $ headers -- Yes, just a shortcut -failure :: (MonadIO a) => T.Text -> a b +failure :: (HasCallStack, MonadIO a) => T.Text -> a b failure reason = (liftIO $ HUnit.assertFailure $ T.unpack reason) >> error "" type TestApp site = (site, Middleware) diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 3092dfb4..e2c6334e 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 1.6.10 +version: 1.6.11 license: MIT license-file: LICENSE author: Nubis