WIP - Add testModifySite

yesod-test/Yesod/Test.hs

@@ -45,6 +45,9 @@ module Yesod.Test
     , ydescribe
     , yit
 
+    -- * Modify test site
+    , testModifySite
+
     -- * Modify test state
     , testSetCookie
     , testDeleteCookie
@@ -341,6 +344,18 @@ yesodSpecApp site getApp yspecs =
 yit :: String -> YesodExample site () -> YesodSpec site
 yit label example = tell [YesodSpecItem label example]
 
+-- | Modifies the site ('yedSite') of the test
+-- 
+-- TODO documentation here
+--
+-- TODO @since
+testModifySite :: YesodDispatch site => (site -> site) -> Middleware -> YesodExample site ()
+testModifySite newSiteFn middleware = do
+  currentSite <- getTestYesod 
+  let newSite = newSiteFn currentSite
+  app <- liftIO $ toWaiAppPlain newSite
+  modifySIO $ \yed -> yed { yedSite = newSite, yedApp = middleware app }
+
 -- | Sets a cookie
 --
 -- ==== __Examples__

yesod-test/test/main.hs

@@ -42,6 +42,7 @@ import Network.HTTP.Types.Status (status301, status303, status403, status422, un
 import UnliftIO.Exception (tryAny, SomeException, try)
 import qualified Web.Cookie as Cookie
 import Data.Maybe (isNothing)
+import qualified Data.Text as T
 
 parseQuery_ :: Text -> [[SelectorGroup]]
 parseQuery_ = either error id . parseQuery
@@ -49,14 +50,24 @@ parseQuery_ = either error id . parseQuery
 findBySelector_ :: HtmlLBS -> Query -> [String]
 findBySelector_ x = either error id . findBySelector x
 
-data RoutedApp = RoutedApp
+data RoutedApp = RoutedApp { routedAppInteger :: Integer }
+
+defaultRoutedApp :: RoutedApp
+defaultRoutedApp = RoutedApp 0
 
 mkYesod "RoutedApp" [parseRoutes|
 /                HomeR      GET POST
 /resources       ResourcesR POST
 /resources/#Text ResourceR  GET
+/get-integer     IntegerR   GET
 |]
 
+-- data ParamaterizedApp = ParamaterizedApp { parameterizedAppInteger :: Integer }
+
+-- mkYesod "ParamaterizedApp" [parseRoutes|
+-- /get-integer ParameterizedGetInteger GET
+-- |]
+
 main :: IO ()
 main = hspec $ do
     describe "CSS selector parsing" $ do
@@ -378,7 +389,7 @@ main = hspec $ do
             testModifyCookies (\_ -> Map.empty)
             get ("cookie/check-no-cookie" :: Text)
             statusIs 200
-    describe "CSRF with cookies/headers" $ yesodSpec RoutedApp $ do
+    describe "CSRF with cookies/headers" $ yesodSpec defaultRoutedApp $ do
         yit "Should receive a CSRF cookie and add its value to the headers" $ do
             get ("/" :: Text)
             statusIs 200
@@ -420,7 +431,7 @@ main = hspec $ do
             r <- followRedirect
             liftIO $ assertBool "expected a Left when not a redirect" $ isLeft r
 
-    describe "route parsing in tests" $ yesodSpec RoutedApp $ do
+    describe "route parsing in tests" $ yesodSpec defaultRoutedApp $ do
         yit "parses location header into a route" $ do
             -- get CSRF token
             get HomeR
@@ -444,6 +455,14 @@ main = hspec $ do
             loc <- getLocation
             liftIO $ assertBool "expected a Left when not a redirect" $ isLeft loc
 
+    describe "modifying site value" $ yesodSpec defaultRoutedApp $ do
+        yit "can change site value" $ do
+            get ("/get-integer" :: Text)
+            bodyContains "0"
+            testModifySite (\site -> site { routedAppInteger = 1 }) id
+            get ("/get-integer" :: Text)
+            bodyContains "1"
+
     describe "Basic Authentication" $ yesodSpec app $ do
         yit "rejects no header" $ do
             get ("checkBasicAuth" :: Text)
@@ -571,6 +590,9 @@ cookieApp = liteApp $ do
 instance Yesod RoutedApp where
     yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
 
+-- instance Yesod ParameterizedApp where
+--     yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
+
 getHomeR :: Handler Html
 getHomeR = defaultLayout
     [whamlet|
@@ -598,3 +620,8 @@ getResourceR i = defaultLayout
         <p>
             Read item #{i}.
     |]
+
+getIntegerR :: Handler Text
+getIntegerR = do
+    app <- getYesod
+    pure $ T.pack $ show (routedAppInteger app)