sydtest-yesod 0.3.0.2 → 0.3.0.3
raw patch · 8 files changed
+53/−30 lines, 8 files
Files
- CHANGELOG.md +6/−0
- blog-example/Example/Blog.hs +4/−0
- blog-example/Example/BlogSpec.hs +8/−1
- src/Test/Syd/Yesod/Client.hs +9/−3
- src/Test/Syd/Yesod/Def.hs +9/−9
- src/Test/Syd/Yesod/E2E.hs +5/−5
- src/Test/Syd/Yesod/Request.hs +10/−10
- sydtest-yesod.cabal +2/−2
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## [0.3.0.3] - 2025-03-20++### Changed++* Fixed a bug in which dashes weren't correctly dropped from parsed routes.+ ## [0.3.0.2] - 2023-10-09 ### Added
blog-example/Example/Blog.hs view
@@ -48,6 +48,7 @@ / HomeR GET /new-thought NewThoughtR GET POST /thought/#ThoughtId ThoughtR GET+ /dashtest/#String EmptyRouteR GET |] type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)@@ -122,6 +123,9 @@ <p> #{thoughtContents thought} |]++getEmptyRouteR :: String -> Handler Html+getEmptyRouteR t = redirect $ EmptyRouteR t main :: IO () main = runStderrLoggingT $
blog-example/Example/BlogSpec.hs view
@@ -81,7 +81,7 @@ addPostParam "contents" (T.pack contents) statusIs 200 - -- A proprety test that does the above, but also goes and finds the thought that was posted,+ -- A property test that does the above, but also goes and finds the thought that was posted, -- both on the page and in the database. -- We generate alphanumeric titles and contents just so that we don't have to depend on `genvalidity` here and figure out encodings correctly. it "can post any blogpost and then look it up" $ \yc ->@@ -111,3 +111,10 @@ bodyContains $ T.unpack titleText bodyContains $ T.unpack contentsText statusIs 200++ it "can get the correct location when the argument is empty" $ \yc -> do+ forAll arbitrary $ \arg ->+ runYesodClientM yc $ do+ get $ EmptyRouteR arg+ statusIs 303+ locationShouldBe $ EmptyRouteR arg
src/Test/Syd/Yesod/Client.hs view
@@ -130,7 +130,7 @@ requireStatus = statusCode . responseStatus <$> requireResponse -- | Get the 'Location' header of most recently received response.-getLocation :: ParseRoute site => YesodClientM localSite (Either Text (Route site))+getLocation :: (ParseRoute site) => YesodClientM localSite (Either Text (Route site)) getLocation = do mr <- getResponse case mr of@@ -144,12 +144,18 @@ decodePath' :: ByteString -> ([Text], [(Text, Text)]) decodePath' b = let (ss, q) = decodePath $ extractPath b- in (ss, map unJust $ queryToQueryText q)+ in (map resolveDashes ss, map unJust $ queryToQueryText q) unJust (a, Just b) = (a, b) unJust (a, Nothing) = (a, mempty)+ -- See+ -- https://github.com/yesodweb/yesod/blob/8e5059b36f79700aa8f70314f1ce9cc537c99d7d/yesod-core/src/Yesod/Core/Class/Yesod.hs#L193-L195+ -- and+ -- https://github.com/yesodweb/yesod/blob/8e5059b36f79700aa8f70314f1ce9cc537c99d7d/yesod-core/src/Yesod/Core/Class/Yesod.hs#L174-L176+ resolveDashes :: Text -> Text+ resolveDashes t = if T.all (== '-') t then T.drop 1 t else t -- | Get the 'Location' header of most recently received response, and assert that it is a valid Route.-requireLocation :: ParseRoute site => YesodClientM localSite (Route site)+requireLocation :: (ParseRoute site) => YesodClientM localSite (Route site) requireLocation = do errOrLocation <- getLocation case errOrLocation of
src/Test/Syd/Yesod/Def.hs view
@@ -70,7 +70,7 @@ -- > statusIs 200 -- -- This function exists for backward compatibility with yesod-test.-yesodSpec :: YesodDispatch site => site -> YesodSpec site -> Spec+yesodSpec :: (YesodDispatch site) => site -> YesodSpec site -> Spec yesodSpec site = yesodSpecWithSiteGenerator $ pure site -- | Run a test suite using the given 'site' generator.@@ -99,7 +99,7 @@ -- > statusIs 200 -- -- This function exists for backward compatibility with yesod-test.-yesodSpecWithSiteGenerator :: YesodDispatch site => IO site -> YesodSpec site -> Spec+yesodSpecWithSiteGenerator :: (YesodDispatch site) => IO site -> YesodSpec site -> Spec yesodSpecWithSiteGenerator siteGen = yesodSpecWithSiteGeneratorAndArgument $ \() -> siteGen -- | Run a test suite using the given 'site' generator which uses an inner resource.@@ -107,7 +107,7 @@ -- If your 'site' contains any resources that you need to set up using a 'withX' function, you will want to use `yesodSpecWithSiteSupplier` instead. -- -- This function exists for backward compatibility with yesod-test.-yesodSpecWithSiteGeneratorAndArgument :: YesodDispatch site => (a -> IO site) -> YesodSpec site -> SpecWith a+yesodSpecWithSiteGeneratorAndArgument :: (YesodDispatch site) => (a -> IO site) -> YesodSpec site -> SpecWith a yesodSpecWithSiteGeneratorAndArgument func = yesodSpecWithSiteSupplierWith $ \f a -> func a >>= f -- | Using a function that supplies a 'site', run a test suite.@@ -131,18 +131,18 @@ -- > it "returns 200 on the homepage" $ do -- > get HomeR -- > statusIs 200-yesodSpecWithSiteSupplier :: YesodDispatch site => (forall r. (site -> IO r) -> IO r) -> YesodSpec site -> Spec+yesodSpecWithSiteSupplier :: (YesodDispatch site) => (forall r. (site -> IO r) -> IO r) -> YesodSpec site -> Spec yesodSpecWithSiteSupplier func = yesodSpecWithSiteSupplierWith (\f () -> func f) -- | Using a function that supplies a 'site', based on an inner resource, run a test suite.-yesodSpecWithSiteSupplierWith :: YesodDispatch site => (forall r. (site -> IO r) -> (inner -> IO r)) -> YesodSpec site -> SpecWith inner+yesodSpecWithSiteSupplierWith :: (YesodDispatch site) => (forall r. (site -> IO r) -> (inner -> IO r)) -> YesodSpec site -> SpecWith inner yesodSpecWithSiteSupplierWith func = managerSpec . yesodSpecWithSiteSetupFunc' (\_ inner -> SetupFunc $ \takeSite -> func takeSite inner) -- | Using a function that supplies a 'site', using a 'SetupFunc' -- -- This function assumed that you've already set up the 'HTTP.Manager' beforehand using something like 'managerSpec'. yesodSpecWithSiteSetupFunc ::- YesodDispatch site =>+ (YesodDispatch site) => (HTTP.Manager -> SetupFunc site) -> TestDef (HTTP.Manager ': outers) (YesodClient site) -> TestDef (HTTP.Manager ': outers) ()@@ -152,7 +152,7 @@ -- -- This function assumed that you've already set up the 'HTTP.Manager' beforehand using something like 'managerSpec'. yesodSpecWithSiteSetupFunc' ::- YesodDispatch site =>+ (YesodDispatch site) => (HTTP.Manager -> inner -> SetupFunc site) -> TestDef (HTTP.Manager ': outers) (YesodClient site) -> TestDef (HTTP.Manager ': outers) inner@@ -160,7 +160,7 @@ site <- setupFunc man inner yesodClientSetupFunc man site -yesodClientSetupFunc :: YesodDispatch site => HTTP.Manager -> site -> SetupFunc (YesodClient site)+yesodClientSetupFunc :: (YesodDispatch site) => HTTP.Manager -> site -> SetupFunc (YesodClient site) yesodClientSetupFunc man site = do application <- liftIO $ Yesod.toWaiAppPlain site p <- applicationSetupFunc application@@ -193,7 +193,7 @@ -- > yit = it yit :: forall site.- HasCallStack =>+ (HasCallStack) => String -> YesodClientM site () -> YesodSpec site
src/Test/Syd/Yesod/E2E.hs view
@@ -75,25 +75,25 @@ data E2E site = E2E deriving (Show, Eq, Generic) -instance Yesod site => Yesod (E2E site)+instance (Yesod site) => Yesod (E2E site) instance (Eq (Route site), RenderRoute site) => RenderRoute (E2E site) where data Route (E2E site) = E2ERoute {unE2ERoute :: Route site} deriving (Generic) renderRoute (E2ERoute route) = renderRoute route -instance Show (Route site) => Show (Route (E2E site)) where+instance (Show (Route site)) => Show (Route (E2E site)) where show = show . unE2ERoute -instance Eq (Route site) => Eq (Route (E2E site)) where+instance (Eq (Route site)) => Eq (Route (E2E site)) where (==) = (==) `on` unE2ERoute -instance RenderRoute site => RedirectUrl (E2E site) (Route site) where+instance (RenderRoute site) => RedirectUrl (E2E site) (Route site) where toTextUrl route = do let (urlPieces, queryParams) = renderRoute (E2ERoute route) q = queryTextToQuery $ map (second Just) queryParams pathBS = encodePath urlPieces q pure $ TE.decodeUtf8 (LB.toStrict (BB.toLazyByteString pathBS)) -- Not safe, but it will fail during testing (if at all) so should be ok. -instance ParseRoute site => ParseRoute (E2E site) where+instance (ParseRoute site) => ParseRoute (E2E site) where parseRoute = fmap E2ERoute . parseRoute
src/Test/Syd/Yesod/Request.hs view
@@ -65,7 +65,7 @@ setMethod method -- | Synonym of 'statusShouldBe' for compatibility with yesod-test-statusIs :: HasCallStack => Int -> YesodClientM site ()+statusIs :: (HasCallStack) => Int -> YesodClientM site () statusIs = statusShouldBe -- | Assert the status of the most recently received response.@@ -73,7 +73,7 @@ -- > it "returns 200 on the home route" $ do -- > get HomeR -- > statusShouldBe 200-statusShouldBe :: HasCallStack => Int -> YesodClientM site ()+statusShouldBe :: (HasCallStack) => Int -> YesodClientM site () statusShouldBe expected = withLastRequestContext $ do actual <- requireStatus@@ -94,7 +94,7 @@ -- | Assert the last response has the given text. -- -- The check is performed using the response body in full text form without any html parsing.-bodyContains :: HasCallStack => String -> YesodExample site ()+bodyContains :: (HasCallStack) => String -> YesodExample site () bodyContains text = withLastRequestContext $ do resp <- requireResponse@@ -318,7 +318,7 @@ setRequestBody body = State.modify' $ \r -> r {requestBuilderDataPostData = BinaryPostData body} -- | Look up the CSRF token from the given form data and add it to the request header-addToken_ :: HasCallStack => Text -> RequestBuilder site ()+addToken_ :: (HasCallStack) => Text -> RequestBuilder site () addToken_ scope = do matches <- liftClient $ htmlQuery $ scope <> " input[name=_token][type=hidden][value]" case matches of@@ -331,16 +331,16 @@ _ -> liftIO $ expectationFailure "More than one CSRF token found in the page" -- | Look up the CSRF token from the only form data and add it to the request header-addToken :: HasCallStack => RequestBuilder site ()+addToken :: (HasCallStack) => RequestBuilder site () addToken = addToken_ "" -- | Look up the CSRF token from the cookie with name 'defaultCsrfCookieName' and add it to the request header with name 'defaultCsrfHeaderName'.-addTokenFromCookie :: HasCallStack => 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 given request header. addTokenFromCookieNamedToHeaderNamed ::- HasCallStack =>+ (HasCallStack) => -- | The name of the cookie ByteString -> -- | The name of the header@@ -402,7 +402,7 @@ ) -- | Query the last response using CSS selectors, returns a list of matched fragments-htmlQuery :: HasCallStack => CSS.Query -> YesodExample site [CSS.HtmlLBS]+htmlQuery :: (HasCallStack) => CSS.Query -> YesodExample site [CSS.HtmlLBS] htmlQuery query = do mResp <- getResponse case mResp of@@ -423,7 +423,7 @@ -- > _ <- followRedirect -- > statusIs 200 followRedirect ::- Yesod site =>+ (Yesod site) => -- | 'Left' with an error message if not a redirect, 'Right' with the redirected URL if it was YesodExample site (Either Text Text) followRedirect = do@@ -438,7 +438,7 @@ in get url >> return (Right url) followRedirect_ ::- Yesod site =>+ (Yesod site) => YesodExample site () followRedirect_ = do errOrRedirect <- followRedirect
sydtest-yesod.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: sydtest-yesod-version: 0.3.0.2+version: 0.3.0.3 synopsis: A yesod companion library for sydtest category: Testing homepage: https://github.com/NorfairKing/sydtest#readme