Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add before hooks and a function instance to Example #1750

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Add before hooks and a function instance to Example #1750

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
147 changes: 120 additions & 27 deletions yesod-test/Yesod/Test.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -117,13 +117,20 @@ module Yesod.Test
, yesodSpecApp
, YesodExample
, YesodExampleData(..)
, yesodExampleDataFromApp
, yesodExampleDataFromTestApp
, TestApp
, YSpec
, testApp
, minimalTestApp
, YesodSpecTree (..)
, ydescribe
, yit

-- * Hooks
, beforeApp
, beforeWithApp

-- * Modify test site
, testModifySite

Expand Down Expand Up @@ -220,9 +227,11 @@ module Yesod.Test
, htmlQuery
, parseHTML
, withResponse
-- * YesodExa
) where

import qualified Test.Hspec.Core.Spec as Hspec
import qualified Test.Hspec.Core.Hooks as Hspec
import qualified Data.List as DL
import qualified Data.ByteString.Char8 as BS8
import Data.ByteString (ByteString)
Expand Down Expand Up @@ -287,14 +296,37 @@ import Yesod.Test.Internal (getBodyTextPreview, contentTypeHeaderIsUtf8)

-- | The state used in a single test case defined using 'yit'
--
-- Since 1.2.4
-- @since 1.2.4
data YesodExampleData site = YesodExampleData
{ yedApp :: !Application
, yedSite :: !site
, yedCookies :: !Cookies
, yedResponse :: !(Maybe SResponse)
}

-- |
--
-- @since TODO
yesodExampleDataFromApp :: YesodDispatch site => site -> IO (YesodExampleData site)
yesodExampleDataFromApp site = do
app <- toWaiAppPlain site
pure YesodExampleData
{ yedApp = app
, yedSite = site
, yedCookies = M.empty
, yedResponse = Nothing
}

-- |
--
-- @since TODO
yesodExampleDataFromTestApp :: YesodDispatch site => TestApp site -> IO (YesodExampleData site)
yesodExampleDataFromTestApp (site, middleware) = do
yed <- yesodExampleDataFromApp site
pure yed
{ yedApp = middleware (yedApp yed)
}

-- | A single test case, to be run with 'yit'.
--
-- Since 1.2.0
Expand Down Expand Up @@ -366,13 +398,8 @@ yesodSpec site yspecs =
where
unYesod (YesodSpecGroup x y) = Hspec.specGroup x $ map unYesod y
unYesod (YesodSpecItem x y) = Hspec.specItem x $ do
app <- toWaiAppPlain site
evalSIO y YesodExampleData
{ yedApp = app
, yedSite = site
, yedCookies = M.empty
, yedResponse = Nothing
}
yed <- yesodExampleDataFromApp site
evalSIO y yed

-- | Same as yesodSpec, but instead of taking already built site it
-- takes an action which produces site for each test.
Expand All @@ -397,13 +424,8 @@ yesodSpecWithSiteGeneratorAndArgument getSiteAction yspecs =
unYesod getSiteAction' (YesodSpecGroup x y) = Hspec.specGroup x $ map (unYesod getSiteAction') y
unYesod getSiteAction' (YesodSpecItem x y) = Hspec.specItem x $ \a -> do
site <- getSiteAction' a
app <- toWaiAppPlain site
evalSIO y YesodExampleData
{ yedApp = app
, yedSite = site
, yedCookies = M.empty
, yedResponse = Nothing
}
yed <- yesodExampleDataFromApp site
evalSIO y yed
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So, a problem with the current implementation (as surfaced in the pending test), is that we can't persist state from the YesodExampleData that is generated. We're doing evalSIO y yed and throwing away the modified state.

This means our beforeApp and beforeWithApp hooks can modify the database and return database entities, but those entities (and any changes made to the app, like sessions or logins) won't be kept.

A proper fix would probably thread the YesodExampleData through the whole thing, and then only let it get cleared out in the Example instance.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I haven't looked in depth yet, but would using a mutable variable be a solution here?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The SIO stuff is already a mutable variable. We're just not threading it through and re-using it afterwards.


-- | Same as yesodSpec, but instead of taking a site it
-- takes an action which produces the 'Application' for each test.
Expand Down Expand Up @@ -431,7 +453,7 @@ yit :: String -> YesodExample site () -> YesodSpec site
yit label example = tell [YesodSpecItem label example]

-- | Modifies the site ('yedSite') of the test, and creates a new WAI app ('yedApp') for it.
--
--
-- yesod-test allows sending requests to your application to test that it handles them correctly.
-- In rare cases, you may wish to modify that application in the middle of a test.
-- This may be useful if you wish to, for example, test your application under a certain configuration,
Expand All @@ -455,7 +477,7 @@ testModifySite :: YesodDispatch site
=> (site -> IO (site, Middleware)) -- ^ A function from the existing site, to a new site and middleware for a WAI app.
-> YesodExample site ()
testModifySite newSiteFn = do
currentSite <- getTestYesod
currentSite <- getTestYesod
(newSite, middleware) <- liftIO $ newSiteFn currentSite
app <- liftIO $ toWaiAppPlain newSite
modifySIO $ \yed -> yed { yedSite = newSite, yedApp = middleware app }
Expand Down Expand Up @@ -812,7 +834,7 @@ printMatches query = do
matches <- htmlQuery query
liftIO $ hPutStrLn stderr $ show matches

-- | Add a parameter with the given name and value to the request body.
-- | Add a parameter with the given name and value to the request body.
-- This function can be called multiple times to add multiple parameters, and be mixed with calls to 'addFile'.
--
-- "Post parameter" is an informal description of what is submitted by making an HTTP POST with an HTML @\<form\>@.
Expand Down Expand Up @@ -1367,7 +1389,7 @@ setUrl url' = do
-- > get "/foobar"
-- > clickOn "a#idofthelink"
--
-- @since 1.5.7
-- @since 1.5.7
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 ->
Expand Down Expand Up @@ -1576,27 +1598,98 @@ failure :: (HasCallStack, MonadIO a) => T.Text -> a b
failure reason = (liftIO $ HUnit.assertFailure $ T.unpack reason) >> error ""

type TestApp site = (site, Middleware)

testApp :: site -> Middleware -> TestApp site
testApp site middleware = (site, middleware)

-- | Creates a 'TestApp' and provides a no-op middleware.
--
-- @since TODO
minimalTestApp :: site -> TestApp site
minimalTestApp site = (site, id)

type YSpec site = Hspec.SpecWith (TestApp site)

instance YesodDispatch site => Hspec.Example (SIO (YesodExampleData site) a) where
type Arg (SIO (YesodExampleData site) a) = TestApp site

evaluateExample example params action =
Hspec.evaluateExample
(action $ \(site, middleware) -> do
app <- toWaiAppPlain site
_ <- evalSIO example YesodExampleData
{ yedApp = middleware app
, yedSite = site
, yedCookies = M.empty
, yedResponse = Nothing
}
(action $ \testApp -> do
yed <- yesodExampleDataFromTestApp testApp
_ <- evalSIO example yed
return ())
params
($ ())

instance YesodDispatch site => Hspec.Example (r -> SIO (YesodExampleData site) a) where
type Arg (r -> SIO (YesodExampleData site) a) =
(TestApp site, r)

evaluateExample example params action =
Hspec.evaluateExample
(action $ \(testApp, r) -> do
yed <- yesodExampleDataFromTestApp testApp
_ <- evalSIO (example r) yed
return ())
params
($ ())
Comment on lines +1625 to +1636
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This lets us use beforeApp and provide the value created as a lambda.

beforeApp (pure "asdf") $ do
    it "has asdf" $ \asdf -> do
        pure () :: YesodExample site ()
        liftIO $ asdf `shouldBe` "asdf"


-- | Like 'Test.Hspec.before' from "Test.Hspec", but works with the 'YesodExample'
-- type. Allows you to provide extra context to a group of test cases.
--
-- @
-- spec :: Spec
-- spec = withApp $ do
-- 'beforeApp' createAndAuthenticateUser $ do
-- 'it' "has a user" $ \\user -> do
-- 'post' (MyRouteR ('entityKey' user))
-- 'statusIs' 200
-- @
--
-- @since TODO
beforeApp
:: (YesodDispatch site)
=> YesodExample site a
-> Hspec.SpecWith (TestApp site, a)
-> Hspec.SpecWith (TestApp site)
beforeApp action =
Hspec.beforeWith $ \testapp -> do
yesodExampleData <- yesodExampleDataFromTestApp testapp
a <- evalSIO action yesodExampleData
pure (testapp, a)

-- | Like 'Test.Hspec.beforeWith', but this works with 'YesodExample' type.
--
-- Useful to modify the existing context as provided by 'beforeApp'. This
-- allows you to create shared contexts among a group of spec items.
--
-- @
-- spec :: Spec
-- spec = withApp $ do
-- 'beforeApp' createAndAuthenticateUser $ do
-- 'it' "has a user" $ \\user -> do
-- 'post' (MyRouteR ('entityKey' user))
-- 'statusIs' 200
--
-- 'beforeWithApp' createOrganizationForUser $ do
-- 'it' "has an organization, too" $ \(user, organization) -> do
-- 'post' (OtherRouteR ('entityKey' user) ('entityKey' organization))
-- 'statusIs' 200
-- @
--
-- @since TODO
beforeWithApp
:: YesodDispatch site
=> (a -> YesodExample site b)
-> Hspec.SpecWith (TestApp site, b)
-> Hspec.SpecWith (TestApp site, a)
beforeWithApp action =
Hspec.beforeWith $ \(testapp, a) -> do
yesodExampleData <- yesodExampleDataFromTestApp testapp
b <- evalSIO (action a) yesodExampleData
pure (testapp, b)

-- | State + IO
--
-- @since 1.6.0
Expand Down
17 changes: 17 additions & 0 deletions yesod-test/test/main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -502,6 +502,23 @@ main = hspec $ do
statusIs 200
(requireJSONResponse :: YesodExample site [Text]) `liftedShouldThrow` (\(e :: SomeException) -> True)

describe "Hooks" $ do
before (pure $ minimalTestApp app) $ do
it "can run regular tests" $ do
get ("get-json-response" :: Text)
statusIs 200
xs <- requireJSONResponse
assertEq "The value is [1]" xs [1 :: Integer]
describe "Root Route" $ do
beforeApp (get ("/" :: Text)) $ do
it "can do stuff" $ \() -> do
liftIO $ pendingWith "This test currently fails because the SIO type can't share the state. When we do an `evalSIO` in `beforeApp`, that throws away all the changes made, so requests are not persisted."
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

sad face

statusIs 200





instance RenderMessage LiteApp FormMessage where
renderMessage _ _ = defaultFormMessage

Expand Down