Merge pull request #1710 from yesodweb/pb/has-callstack

Fix up missing HasCallStack

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)

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)

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 <nubis@woobiz.com.ar>