Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell98 |
Write hspec tests that are webdriver tests, automatically managing the webdriver sessions.
This module re-exports functions from Test.Hspec and Test.WebDriver.Commands and it is
intended that you just import Test.Hspec.WebDriver
. If you need to import Test.Hspec
or
Test.WebDriver
, you should do so using a qualified import.
{-# LANGUAGE OverloadedStrings #-} module XKCD where import Test.Hspec.WebDriver allBrowsers :: [Capabilities] allBrowsers = [firefoxCaps, chromeCaps, ieCaps] browsersExceptIE :: [Capabilities] browsersExceptIE = [firefoxCaps, chromeCaps] main :: IO () main = hspec $ describe "XKCD Tests" $ do session "for 327" $ using allBrowsers $ do it "opens the page" $ runWD $ openPage "http://www.xkcd.com/327/" it "checks hover text" $ runWD $ do e <- findElem $ ByCSS "div#comic > img" e `shouldBeTag` "img" e `shouldHaveAttr` ("title", "Her daughter is named Help I'm trapped in a driver's license factory.") parallel $ session "for 303" $ using browsersExceptIE $ do it "opens the page" $ runWD $ openPage "http://www.xkcd.com/303/" it "checks the title" $ runWD $ do e <- findElem $ ById "ctitle" e `shouldBeTag` "div" e `shouldHaveText` "Compiling"
The above code assumes selenium-server-standalone is running on 127.0.0.1:4444
at path
/wd/hub
(this is the default).
Synopsis
- data WdExample multi
- data WdOptions = WdOptions {}
- runWD :: WD () -> WdExample ()
- runWDOptions :: WdOptions -> WD () -> WdExample ()
- runWDWith :: multi -> WD () -> WdExample multi
- runWDWithOptions :: multi -> WdOptions -> WD () -> WdExample multi
- pending :: WdExample multi
- pendingWith :: String -> WdExample multi
- example :: Default multi => Expectation -> WdExample multi
- session :: String -> ([Capabilities], SpecWith (WdTestSession multi)) -> Spec
- sessionWith :: WDConfig -> String -> ([(Capabilities, String)], SpecWith (WdTestSession multi)) -> Spec
- inspectSession :: WD ()
- using :: [caps] -> SpecWith (WdTestSession multi) -> ([caps], SpecWith (WdTestSession multi))
- data WdTestSession multi
- firefoxCaps :: Capabilities
- chromeCaps :: Capabilities
- ieCaps :: Capabilities
- operaCaps :: Capabilities
- iphoneCaps :: Capabilities
- ipadCaps :: Capabilities
- androidCaps :: Capabilities
- shouldBe :: (Show a, Eq a) => a -> a -> WD ()
- shouldBeTag :: Element -> Text -> WD ()
- shouldHaveText :: Element -> Text -> WD ()
- shouldHaveAttr :: Element -> (Text, Text) -> WD ()
- shouldReturn :: (Show a, Eq a) => WD a -> a -> WD ()
- shouldThrow :: (Show e, Eq e, Exception e) => WD a -> e -> WD ()
- hspec :: Spec -> IO ()
- type Spec = SpecWith ()
- type SpecWith a = SpecM a ()
- describe :: HasCallStack => String -> SpecWith a -> SpecWith a
- context :: HasCallStack => String -> SpecWith a -> SpecWith a
- it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
- specify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
- parallel :: SpecWith a -> SpecWith a
- runIO :: IO r -> SpecM a r
- data WD a
- data Capabilities
- module Test.WebDriver.Commands
Webdriver Example
A webdriver example.
The webdriver action of type
should interact with the webpage using commands from
Test.WebDriver.Commands (which is re-exported from this module) and then use the
expectations in this module. It is possible to split up the spec of a single page into multiple
examples where later examples start with the web browser state from the end of the previous
example. This is helpful to keep each individual example small and allows the entire spec to be
described at the beginning with pending examples.WD
()
The way this works is that you combine examples into a session using session
or sessionWith
.
A webdriver session is then threaded through all examples in a session so that a later example in
the session can rely on the webbrowser state as set up by the previous example. The type system
enforces that every webdriver example must be located within a call to session
or
sessionWith
. Indeed, a WdExample
produces a
which can
only be converted to SpecWith
(WdTestSession
multi)Spec
using session
or sessionWith
. The reason for the WdPending
constructor is so that a pending example can be specified with type
so it can compose with the other webdriver examples.SpecWith
(WdTestSession
multi)
The type multi
is used when testing multiple sessions at once (e.g. to test multiple
interacting users), otherwise it is ()
. Values of this type are used to determine which browser
session the example should be executed against. A new session is created every time a new value
of type multi
is seen. Note that the type system enforces that every example within the
session has the same type multi
.
Instances
Eq multi => Example (WdExample multi) Source # | |
Defined in Test.Hspec.WebDriver evaluateExample :: WdExample multi -> Params -> (ActionWith (Arg (WdExample multi)) -> IO ()) -> ProgressCallback -> IO Result # | |
type Arg (WdExample multi) Source # | |
Defined in Test.Hspec.WebDriver |
Optional options that can be passed to runWDOptions
.
WdOptions | |
|
runWD :: WD () -> WdExample () Source #
A shorthand for constructing a WdExample
from a webdriver action when you are only testing a
single browser session at once. See the XKCD example at the top of the page.
runWDOptions :: WdOptions -> WD () -> WdExample () Source #
A version of runWD that accepts some custom options
runWDWith :: multi -> WD () -> WdExample multi Source #
Create a webdriver example, specifying which of the multiple sessions the example should be executed against. I suggest you create an enumeration for multi, for example:
data TestUser = Gandolf | Bilbo | Legolas deriving (Show, Eq, Enum, Bounded) runUser :: TestUser -> WD () -> WDExample TestUser runUser = runWDWith spec :: Spec spec = session "tests some page" $ using [firefoxCaps] $ do it "does something with Gandolf" $ runUser Gandolf $ do openPage ... it "does something with Bilbo" $ runUser Bilbo $ do openPage ... it "goes back to the Gandolf session" $ runUser Gandolf $ do e <- findElem .... ...
In the above code, two sessions are created and the examples will go back and forth between the
two sessions. Note that a session for Legolas will only be created the first time he shows up in
a call to runUser
, which might be never. To share information between the sessions (e.g. some
data that Gandolf creates that Bilbo should expect), the best way I have found is to use IORefs
created with runIO
(wrapped in a utility module).
runWDWithOptions :: multi -> WdOptions -> WD () -> WdExample multi Source #
A version of runWDWith that accepts some custom options
pendingWith :: String -> WdExample multi Source #
A pending example with a message.
example :: Default multi => Expectation -> WdExample multi Source #
A version of example
which lifts an IO ()
to a webdriver example (so it can be composed
with other webdriver examples). In the case of multiple sessions, it doesn't really matter which
session the expectation is executed against, so a default value is used. In the case of single
sessions, the type is WdExample ()
.
Webdriver Sessions
session :: String -> ([Capabilities], SpecWith (WdTestSession multi)) -> Spec Source #
Combine the examples nested inside this call into a webdriver session or multiple sessions.
For each of the capabilities in the list, the examples are executed one at a time in depth-first
order and so later examples can rely on the browser state created by earlier examples. These
passes through the examples are independent for different capabilities. Note that when using
parallel
, the examples within a single pass still execute serially. Different passes through
the examples will be executed in parallel. The sessions are managed as follows:
- In the simplest case when
multi
is()
, before the first example is executed a new webdriver session with the given capabilities is created. The examples are then executed in depth-first order, and the session is then closed when either an exception occurs or the examples complete. (The session can be left open withinspectSession
). - More generally, as the examples are executed, each time a new value of type
multi
is seen, a new webdriver session with the capabilities is automatically created. Later examples will continue with the session matching their value ofmulti
.
This function uses the default webdriver host (127.0.0.1), port (4444), and basepath
(/wd/hub
).
sessionWith :: WDConfig -> String -> ([(Capabilities, String)], SpecWith (WdTestSession multi)) -> Spec Source #
A variation of session
which allows you to specify the webdriver configuration. Note that
the capabilities in the WDConfig
will be ignored, instead the capabilities will come from the
list of Capabilities
passed to sessionWith
.
In addition, each capability is paired with a descriptive string which is passed to hspec to
describe the example. By default, session
uses the browser name as the description. sessionWith
supports a more detailed description so that in the hspec output you can distinguish between
capabilities that share the same browser but differ in the details, for example capabilities with and
without javascript.
inspectSession :: WD () Source #
Abort the session without closing the session.
Normally, session
will automatically close the session either when the tests complete without
error or when any of the tests within the session throws an error. When developing the test
suite, this can be annoying since closing the session causes the browser window to close.
Therefore, while developing the test suite, you can insert a call to inspectSession
. This will
immedietly halt the session (all later tests will fail) but will not close the session so that
the browser window stays open.
using :: [caps] -> SpecWith (WdTestSession multi) -> ([caps], SpecWith (WdTestSession multi)) Source #
A synonym for constructing pairs that allows the word using
to be used with session
so that the session
description reads like a sentance.
allBrowsers :: [Capabilities] allBrowsers = [firefoxCaps, chromeCaps, ieCaps] browsersExceptIE :: [Capabilities] browsersExceptIE = [firefoxCaps, chromeCaps] mobileBrowsers :: [Capabilities] mobileBrowsers = [iphoneCaps, ipadCaps, androidCaps] myspec :: Spec myspec = do session "for the home page" $ using allBrowsers $ do it "loads the page" $ runWD $ do ... it "scrolls the carosel" $ runWD $ do ... session "for the users page" $ using browsersExceptIE $ do ...
data WdTestSession multi Source #
Internal state for webdriver test sessions.
Default Capabilities
firefoxCaps :: Capabilities Source #
Default capabilities which can be used in the list passed to using
. I suggest creating a
top-level definition such as allBrowsers
and browsersWithoutIE
such as in the XKCD example at
the top of the page, so that you do not specify the browsers in the individual spec.
chromeCaps :: Capabilities Source #
Default capabilities which can be used in the list passed to using
. I suggest creating a
top-level definition such as allBrowsers
and browsersWithoutIE
such as in the XKCD example at
the top of the page, so that you do not specify the browsers in the individual spec.
ieCaps :: Capabilities Source #
Default capabilities which can be used in the list passed to using
. I suggest creating a
top-level definition such as allBrowsers
and browsersWithoutIE
such as in the XKCD example at
the top of the page, so that you do not specify the browsers in the individual spec.
operaCaps :: Capabilities Source #
Default capabilities which can be used in the list passed to using
. I suggest creating a
top-level definition such as allBrowsers
and browsersWithoutIE
such as in the XKCD example at
the top of the page, so that you do not specify the browsers in the individual spec.
iphoneCaps :: Capabilities Source #
Default capabilities which can be used in the list passed to using
. I suggest creating a
top-level definition such as allBrowsers
and browsersWithoutIE
such as in the XKCD example at
the top of the page, so that you do not specify the browsers in the individual spec.
ipadCaps :: Capabilities Source #
Default capabilities which can be used in the list passed to using
. I suggest creating a
top-level definition such as allBrowsers
and browsersWithoutIE
such as in the XKCD example at
the top of the page, so that you do not specify the browsers in the individual spec.
androidCaps :: Capabilities Source #
Default capabilities which can be used in the list passed to using
. I suggest creating a
top-level definition such as allBrowsers
and browsersWithoutIE
such as in the XKCD example at
the top of the page, so that you do not specify the browsers in the individual spec.
Expectations
shouldBeTag :: Element -> Text -> WD () Source #
Asserts that the given element matches the given tag.
shouldHaveText :: Element -> Text -> WD () Source #
Asserts that the given element has the given text.
shouldHaveAttr :: Element -> (Text, Text) -> WD () Source #
Asserts that the given elemnt has the attribute given by (attr name, value)
.
shouldReturn :: (Show a, Eq a) => WD a -> a -> WD () Source #
Asserts that the action returns the expected result.
shouldThrow :: (Show e, Eq e, Exception e) => WD a -> e -> WD () Source #
Asserts that the action throws an exception.
Re-exports from Test.Hspec
Run a given spec and write a report to stdout
.
Exit with exitFailure
if at least one spec item fails.
Note: hspec
handles command-line options and reads config files. This
is not always desirable. Use evalSpec
and runSpecForest
if you need
more control over these aspects.
describe :: HasCallStack => String -> SpecWith a -> SpecWith a #
The describe
function combines a list of specs into a larger spec.
it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) #
The it
function creates a spec item.
A spec item consists of:
- a textual description of a desired behavior
- an example for that behavior
describe "absolute" $ do it "returns a positive number when given a negative number" $ absolute (-1) == 1
specify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) #
specify
is an alias for it
.
parallel :: SpecWith a -> SpecWith a #
parallel
marks all spec items of the given spec to be safe for parallel
evaluation.
Run an IO action while constructing the spec tree.
SpecM
is a monad to construct a spec tree, without executing any spec
items. runIO
allows you to run IO actions during this construction phase.
The IO action is always run when the spec tree is constructed (e.g. even
when --dry-run
is specified).
If you do not need the result of the IO action to construct the spec tree,
beforeAll
may be more suitable for your use case.
Re-exports from Test.WebDriver
A state monad for WebDriver commands.
Instances
MonadFix WD | |
Defined in Test.WebDriver.Monad | |
MonadIO WD | |
Defined in Test.WebDriver.Monad | |
Applicative WD | |
Functor WD | |
Monad WD | |
MonadCatch WD | |
MonadMask WD | |
MonadThrow WD | |
Defined in Test.WebDriver.Monad | |
WebDriver WD | |
Defined in Test.WebDriver.Monad | |
WDSessionState WD | |
Defined in Test.WebDriver.Monad getSession :: WD WDSession # putSession :: WDSession -> WD () # | |
MonadBaseControl IO WD | |
MonadBase IO WD | |
Defined in Test.WebDriver.Monad | |
type StM WD a | |
data Capabilities #
A structure describing the capabilities of a session. This record serves dual roles.
- It's used to specify the desired capabilities for a session before it's created. In this usage, fields that are set to Nothing indicate that we have no preference for that capability.
- When received from the server , it's used to describe the actual capabilities given to us by the WebDriver server. Here a value of Nothing indicates that the server doesn't support the capability. Thus, for Maybe Bool fields, both Nothing and Just False indicate a lack of support for the desired capability.
Instances
FromJSON Capabilities | |
Defined in Test.WebDriver.Capabilities parseJSON :: Value -> Parser Capabilities # parseJSONList :: Value -> Parser [Capabilities] # | |
ToJSON Capabilities | |
Defined in Test.WebDriver.Capabilities toJSON :: Capabilities -> Value # toEncoding :: Capabilities -> Encoding # toJSONList :: [Capabilities] -> Value # toEncodingList :: [Capabilities] -> Encoding # | |
Show Capabilities | |
Defined in Test.WebDriver.Capabilities showsPrec :: Int -> Capabilities -> ShowS # show :: Capabilities -> String # showList :: [Capabilities] -> ShowS # | |
Default Capabilities | |
Defined in Test.WebDriver.Capabilities def :: Capabilities # | |
Eq Capabilities | |
Defined in Test.WebDriver.Capabilities (==) :: Capabilities -> Capabilities -> Bool # (/=) :: Capabilities -> Capabilities -> Bool # | |
GetCapabilities Capabilities | |
Defined in Test.WebDriver.Capabilities getCaps :: Capabilities -> Capabilities # |
module Test.WebDriver.Commands