{-# LANGUAGE OverloadedStrings, FlexibleInstances, DeriveDataTypeable, TypeFamilies, CPP, NamedFieldPuns #-}
-- | 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).
module Test.Hspec.WebDriver(
  -- * Webdriver Example
    WdExample(..)
  , WdOptions (..)
  , runWD
  , runWDOptions
  , runWDWith
  , runWDWithOptions
  , pending
  , pendingWith
  , example

  -- * Webdriver Sessions
  , session
  , sessionWith
  , inspectSession
  , using
  , WdTestSession

  -- * Default Capabilities
  , firefoxCaps
  , chromeCaps
  , ieCaps
  , operaCaps
  , iphoneCaps
  , ipadCaps
  , androidCaps

  -- * Expectations
  , shouldBe
  , shouldBeTag
  , shouldHaveText
  , shouldHaveAttr
  , shouldReturn
  , shouldThrow

  -- * Re-exports from "Test.Hspec"
  , hspec
  , Spec
  , SpecWith
  , describe
  , context
  , it
  , specify
  , parallel
  , runIO

  -- * Re-exports from "Test.WebDriver"
  , WD
  , Capabilities
  , module Test.WebDriver.Commands
) where

import Control.Concurrent.MVar (MVar, takeMVar, putMVar, newEmptyMVar)
import Control.Exception (SomeException(..))
import Control.Exception.Lifted (try, Exception, onException, throwIO)
import Control.Monad (replicateM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (state, evalState, execState)
import Data.Default (Default(..))
import Data.IORef (newIORef, writeIORef, readIORef)
import qualified Data.Text as T
import Data.Typeable (Typeable, cast)
import Test.HUnit (assertEqual, assertFailure)
import qualified Data.Aeson as A

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), Applicative)
import Data.Traversable (traverse)
#endif

import qualified Test.Hspec as H
import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow, pending, pendingWith, example)
import Test.Hspec.Core.Spec (Result(..), ResultStatus(..))
import Test.Hspec.Core.Spec (Item(..), Example(..), SpecTree, Tree(..), fromSpecList, runSpecM)

import Test.WebDriver (WD, Capabilities)
import qualified Test.WebDriver as W
import Test.WebDriver.Commands
import qualified Test.WebDriver.Config as W
import qualified Test.WebDriver.Capabilities as W
import qualified Test.WebDriver.Session as W

-- | The state passed between examples inside the mvars.
data SessionState multi = SessionState {
    -- | The already created sessions
    forall multi. SessionState multi -> [(multi, WDSession)]
stSessionMap :: [(multi, W.WDSession)]
    -- | True if the previous example had an error
  , forall multi. SessionState multi -> Bool
stPrevHadError :: Bool
    -- | True if the previous example was aborted with 'inspectSession'
  , forall multi. SessionState multi -> Bool
stPrevAborted :: Bool
    -- | Create a new session
  , forall multi. SessionState multi -> IO WDSession
stCreateSession :: IO W.WDSession
}

-- | Internal state for webdriver test sessions.
data WdTestSession multi = WdTestSession {
    forall multi. WdTestSession multi -> IO (SessionState multi)
wdTestOpen :: IO (SessionState multi)
  , forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose :: SessionState multi -> IO ()
}

-- | A webdriver example.
--
-- The webdriver action of type @'WD' ()@ should interact with the webpage using commands from
-- "Test.WebDriver.Commands" (which is re-exported from this module) and then use the
-- <#g:4 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.
--
-- 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 @'SpecWith' ('WdTestSession' multi)@ which can
-- only be converted to 'Spec' using 'session' or 'sessionWith'.  The reason for the 'WdPending'
-- constructor is so that a pending example can be specified with type @'SpecWith' ('WdTestSession'
-- multi)@ so it can compose with the other webdriver examples.
--
-- 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@.
data WdExample multi = WdExample multi WdOptions (WD ()) | WdPending (Maybe String)

-- | Optional options that can be passed to 'runWDOptions'.
data WdOptions = WdOptions {
  -- | As soon as an example fails, skip all remaining tests in the session.  Defaults to True.
  WdOptions -> Bool
skipRemainingTestsAfterFailure :: Bool
  }

instance Default WdOptions where
  def :: WdOptions
def = WdOptions { skipRemainingTestsAfterFailure :: Bool
skipRemainingTestsAfterFailure = Bool
True }

-- | 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.
runWD :: WD () -> WdExample ()
runWD :: WD () -> WdExample ()
runWD = forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample () forall a. Default a => a
def

-- | A version of runWD that accepts some custom options
runWDOptions :: WdOptions -> WD () -> WdExample ()
runWDOptions :: WdOptions -> WD () -> WdExample ()
runWDOptions = forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample ()

-- | 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).
runWDWith :: multi -> WD () -> WdExample multi
runWDWith :: forall multi. multi -> WD () -> WdExample multi
runWDWith multi
multi = forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample multi
multi forall a. Default a => a
def

-- | A version of runWDWith that accepts some custom options
runWDWithOptions :: multi -> WdOptions -> WD () -> WdExample multi
runWDWithOptions :: forall multi. multi -> WdOptions -> WD () -> WdExample multi
runWDWithOptions = forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample

-- | A pending example.
pending :: WdExample multi
pending :: forall multi. WdExample multi
pending = forall multi. Maybe [Char] -> WdExample multi
WdPending forall a. Maybe a
Nothing

-- | A pending example with a message.
pendingWith :: String -> WdExample multi
pendingWith :: forall multi. [Char] -> WdExample multi
pendingWith = forall multi. Maybe [Char] -> WdExample multi
WdPending forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

-- | A version of 'H.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 ()@.
example :: Default multi => Expectation -> WdExample multi
example :: forall multi. Default multi => IO () -> WdExample multi
example = forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample forall a. Default a => a
def forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | 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 with 'inspectSession').
--
-- * 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 of @multi@.
--
-- This function uses the default webdriver host (127.0.0.1), port (4444), and basepath
-- (@\/wd\/hub@).
session :: String -> ([Capabilities], SpecWith (WdTestSession multi)) -> Spec
session :: forall multi.
[Char] -> ([Capabilities], SpecWith (WdTestSession multi)) -> Spec
session [Char]
msg ([Capabilities]
caps, SpecWith (WdTestSession multi)
spec) = forall multi.
WDConfig
-> [Char]
-> ([(Capabilities, [Char])], SpecWith (WdTestSession multi))
-> Spec
sessionWith WDConfig
W.defaultConfig [Char]
msg ([(Capabilities, [Char])]
caps', SpecWith (WdTestSession multi)
spec)
  where
    caps' :: [(Capabilities, [Char])]
caps' = forall a b. (a -> b) -> [a] -> [b]
map Capabilities -> (Capabilities, [Char])
f [Capabilities]
caps
    f :: Capabilities -> (Capabilities, [Char])
f Capabilities
c = case forall a. ToJSON a => a -> Value
A.toJSON (Capabilities -> Browser
W.browser Capabilities
c) of
      A.String Text
b -> (Capabilities
c, Text -> [Char]
T.unpack Text
b)
      Value
_ -> (Capabilities
c, forall a. Show a => a -> [Char]
show Capabilities
c) -- this should not be the case, every browser toJSON is a string

-- | A variation of 'session' which allows you to specify the webdriver configuration.  Note that
-- the capabilities in the 'W.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.
sessionWith :: W.WDConfig -> String -> ([(Capabilities, String)], SpecWith (WdTestSession multi)) -> Spec
sessionWith :: forall multi.
WDConfig
-> [Char]
-> ([(Capabilities, [Char])], SpecWith (WdTestSession multi))
-> Spec
sessionWith WDConfig
cfg [Char]
msg ([(Capabilities, [Char])]
caps, SpecWith (WdTestSession multi)
spec) = SpecWith (Arg (IO ()))
spec'
    where
        procT :: Capabilities -> Spec
procT Capabilities
c = forall multi.
WDConfig -> Capabilities -> SpecWith (WdTestSession multi) -> Spec
procTestSession WDConfig
cfg (forall t. GetCapabilities t => t -> Capabilities
W.getCaps Capabilities
c) SpecWith (WdTestSession multi)
spec
        spec' :: SpecWith (Arg (IO ()))
spec' = case [(Capabilities, [Char])]
caps of
                    [] -> forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
msg forall a b. (a -> b) -> a -> b
$ HasCallStack => [Char] -> IO ()
H.pendingWith [Char]
"No capabilities specified"
                    [(Capabilities
c,[Char]
cDscr)] -> forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char]
msg forall a. [a] -> [a] -> [a]
++ [Char]
" using " forall a. [a] -> [a] -> [a]
++ [Char]
cDscr) forall a b. (a -> b) -> a -> b
$ Capabilities -> Spec
procT Capabilities
c
                    [(Capabilities, [Char])]
_ -> forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
msg forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Capabilities
c,[Char]
cDscr) -> forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char]
"using " forall a. [a] -> [a] -> [a]
++ [Char]
cDscr) forall a b. (a -> b) -> a -> b
$ Capabilities -> Spec
procT Capabilities
c) [(Capabilities, [Char])]
caps

-- | 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
-- >    ...
using :: [caps] -> SpecWith (WdTestSession multi) -> ([caps], SpecWith (WdTestSession multi))
using :: forall caps multi.
[caps]
-> SpecWith (WdTestSession multi)
-> ([caps], SpecWith (WdTestSession multi))
using = (,)

-- | 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.
firefoxCaps, chromeCaps, ieCaps, operaCaps, iphoneCaps, ipadCaps, androidCaps :: Capabilities
firefoxCaps :: Capabilities
firefoxCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.firefox }
chromeCaps :: Capabilities
chromeCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.chrome }
ieCaps :: Capabilities
ieCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.ie }
operaCaps :: Capabilities
operaCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.opera }
iphoneCaps :: Capabilities
iphoneCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.iPhone }
ipadCaps :: Capabilities
ipadCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.iPad }
androidCaps :: Capabilities
androidCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.android }

data AbortSession = AbortSession
    deriving (Int -> AbortSession -> ShowS
[AbortSession] -> ShowS
AbortSession -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AbortSession] -> ShowS
$cshowList :: [AbortSession] -> ShowS
show :: AbortSession -> [Char]
$cshow :: AbortSession -> [Char]
showsPrec :: Int -> AbortSession -> ShowS
$cshowsPrec :: Int -> AbortSession -> ShowS
Show, Typeable)
instance Exception AbortSession

-- | 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.
inspectSession :: WD ()
inspectSession :: WD ()
inspectSession = forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO AbortSession
AbortSession

-- | 'H.shouldBe' lifted into the 'WD' monad.
shouldBe :: (Show a, Eq a) => a -> a -> WD ()
a
x shouldBe :: forall a. (Show a, Eq a) => a -> a -> WD ()
`shouldBe` a
y = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ a
x forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`H.shouldBe` a
y

-- | Asserts that the given element matches the given tag.
shouldBeTag :: Element -> T.Text -> WD ()
Element
e shouldBeTag :: Element -> Text -> WD ()
`shouldBeTag` Text
name = do
    Text
t <- forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd Text
tagName Element
e
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Eq a, Show a) => [Char] -> a -> a -> IO ()
assertEqual ([Char]
"tag of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Element
e) Text
name Text
t

-- | Asserts that the given element has the given text.
shouldHaveText :: Element -> T.Text -> WD ()
Element
e shouldHaveText :: Element -> Text -> WD ()
`shouldHaveText` Text
txt = do
    Text
t <- forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd Text
getText Element
e
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Eq a, Show a) => [Char] -> a -> a -> IO ()
assertEqual ([Char]
"text of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Element
e) Text
txt Text
t

-- | Asserts that the given elemnt has the attribute given by @(attr name, value)@.
shouldHaveAttr :: Element -> (T.Text, T.Text) -> WD ()
Element
e shouldHaveAttr :: Element -> (Text, Text) -> WD ()
`shouldHaveAttr` (Text
a, Text
txt) = do
    Maybe Text
t <- forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> Text -> wd (Maybe Text)
attr Element
e Text
a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (HasCallStack, Eq a, Show a) => [Char] -> a -> a -> IO ()
assertEqual ([Char]
"attribute " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
a forall a. [a] -> [a] -> [a]
++ [Char]
" of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Element
e) (forall a. a -> Maybe a
Just Text
txt) Maybe Text
t

-- | Asserts that the action returns the expected result.
shouldReturn :: (Show a, Eq a) => WD a -> a -> WD ()
WD a
action shouldReturn :: forall a. (Show a, Eq a) => WD a -> a -> WD ()
`shouldReturn` a
expected = WD a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
a -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ a
a forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`H.shouldBe` a
expected)

-- | Asserts that the action throws an exception.
shouldThrow :: (Show e, Eq e, Exception e) => WD a -> e -> WD ()
shouldThrow :: forall e a. (Show e, Eq e, Exception e) => WD a -> e -> WD ()
shouldThrow WD a
w e
expected = do
    Either e a
r <- forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try WD a
w
    case Either e a
r of
        Left e
err -> e
err forall a. (Show a, Eq a) => a -> a -> WD ()
`shouldBe` e
expected
        Right a
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ [Char]
"did not get expected exception " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show e
expected

--------------------------------------------------------------------------------
-- Internal Test Runner
--------------------------------------------------------------------------------

-- | Create a WdTestSession.
createTestSession :: W.WDConfig -> [MVar (SessionState multi)] -> Int -> WdTestSession multi
createTestSession :: forall multi.
WDConfig
-> [MVar (SessionState multi)] -> Int -> WdTestSession multi
createTestSession WDConfig
cfg [MVar (SessionState multi)]
mvars Int
n = forall multi.
IO (SessionState multi)
-> (SessionState multi -> IO ()) -> WdTestSession multi
WdTestSession IO (SessionState multi)
open SessionState multi -> IO ()
close
    where
        open :: IO (SessionState multi)
open | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall multi.
[(multi, WDSession)]
-> Bool -> Bool -> IO WDSession -> SessionState multi
SessionState [] Bool
False Bool
False IO WDSession
create
             | Bool
otherwise = forall a. MVar a -> IO a
takeMVar ([MVar (SessionState multi)]
mvars forall a. [a] -> Int -> a
!! Int
n)

        create :: IO WDSession
create = do
            WDSession
s <- forall c (m :: * -> *).
(WebDriverConfig c, MonadBase IO m) =>
c -> m WDSession
W.mkSession WDConfig
cfg
#if MIN_VERSION_webdriver(0,7,0)
            forall a. WDSession -> WD a -> IO a
W.runWD WDSession
s forall a b. (a -> b) -> a -> b
$ forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Capabilities -> wd WDSession
createSession forall a b. (a -> b) -> a -> b
$ WDConfig -> Capabilities
W.wdCapabilities WDConfig
cfg
#else
            W.runWD s $ createSession [] $ W.wdCapabilities cfg
#endif

        close :: SessionState multi -> IO ()
close SessionState multi
st | forall (t :: * -> *) a. Foldable t => t a -> Int
length [MVar (SessionState multi)]
mvars forall a. Num a => a -> a -> a
- Int
1 forall a. Eq a => a -> a -> Bool
== Int
n = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a. WDSession -> WD a -> IO a
`W.runWD` forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
closeSession) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall multi. SessionState multi -> [(multi, WDSession)]
stSessionMap SessionState multi
st
                 | Bool
otherwise = forall a. MVar a -> a -> IO ()
putMVar ([MVar (SessionState multi)]
mvars forall a. [a] -> Int -> a
!! (Int
n forall a. Num a => a -> a -> a
+ Int
1)) SessionState multi
st

-- | Convert a single test item to a generic item by providing it with the WdTestSession.
procSpecItem :: W.WDConfig -> [MVar (SessionState multi)] -> Int -> Item (WdTestSession multi) -> Item ()
procSpecItem :: forall multi.
WDConfig
-> [MVar (SessionState multi)]
-> Int
-> Item (WdTestSession multi)
-> Item ()
procSpecItem WDConfig
cfg [MVar (SessionState multi)]
mvars Int
n Item (WdTestSession multi)
item = Item (WdTestSession multi)
item { itemExample :: Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
itemExample = \Params
p ActionWith () -> IO ()
act ProgressCallback
progress -> forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item (WdTestSession multi)
item Params
p (ActionWith () -> IO ()
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionWith (WdTestSession multi) -> ActionWith ()
act') ProgressCallback
progress }
    where
        act' :: ActionWith (WdTestSession multi) -> ActionWith ()
act' ActionWith (WdTestSession multi)
f () = ActionWith (WdTestSession multi)
f (forall multi.
WDConfig
-> [MVar (SessionState multi)] -> Int -> WdTestSession multi
createTestSession WDConfig
cfg [MVar (SessionState multi)]
mvars Int
n)

-- | Convert a spec tree of test items to a spec tree of generic items by creating a single session for
-- the entire tree.
procTestSession :: W.WDConfig -> Capabilities -> SpecWith (WdTestSession multi) -> Spec
procTestSession :: forall multi.
WDConfig -> Capabilities -> SpecWith (WdTestSession multi) -> Spec
procTestSession WDConfig
cfg Capabilities
cap SpecWith (WdTestSession multi)
s = do
    ([MVar (SessionState multi)]
mvars, [SpecTree (WdTestSession multi)]
trees) <- forall r a. IO r -> SpecM a r
runIO forall a b. (a -> b) -> a -> b
$ do
#if MIN_VERSION_hspec_core(2,10,0)
        (Endo Config
_, [SpecTree (WdTestSession multi)]
trees) <- forall a. SpecWith a -> IO (Endo Config, [SpecTree a])
runSpecM SpecWith (WdTestSession multi)
s
#else
        trees <- runSpecM s
#endif
        let cnt :: Int
cnt = forall a. [SpecTree a] -> Int
countItems [SpecTree (WdTestSession multi)]
trees
        [MVar (SessionState multi)]
mvars <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
cnt forall a. IO (MVar a)
newEmptyMVar
        forall (m :: * -> *) a. Monad m => a -> m a
return ([MVar (SessionState multi)]
mvars, [SpecTree (WdTestSession multi)]
trees)

    forall a. [SpecTree a] -> SpecWith a
fromSpecList forall a b. (a -> b) -> a -> b
$ forall a b.
(Int -> Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
mapWithCounter (forall multi.
WDConfig
-> [MVar (SessionState multi)]
-> Int
-> Item (WdTestSession multi)
-> Item ()
procSpecItem WDConfig
cfg {wdCapabilities :: Capabilities
W.wdCapabilities = Capabilities
cap} [MVar (SessionState multi)]
mvars) [SpecTree (WdTestSession multi)]
trees

instance Eq multi => Example (WdExample multi) where
    type Arg (WdExample multi) = WdTestSession multi
    evaluateExample :: WdExample multi
-> Params
-> (ActionWith (Arg (WdExample multi)) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample (WdPending Maybe [Char]
msg) Params
_ ActionWith (Arg (WdExample multi)) -> IO ()
_ ProgressCallback
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> ResultStatus -> Result
Result [Char]
"" (Maybe Location -> Maybe [Char] -> ResultStatus
Pending forall a. Maybe a
Nothing Maybe [Char]
msg)
    evaluateExample (WdExample multi
multi (WdOptions {Bool
skipRemainingTestsAfterFailure :: Bool
skipRemainingTestsAfterFailure :: WdOptions -> Bool
skipRemainingTestsAfterFailure}) WD ()
wd) Params
_ ActionWith (Arg (WdExample multi)) -> IO ()
act ProgressCallback
_ = do
        IORef Bool
prevHadError <- forall a. a -> IO (IORef a)
newIORef Bool
False
        IORef Bool
aborted <- forall a. a -> IO (IORef a)
newIORef Bool
False

        ActionWith (Arg (WdExample multi)) -> IO ()
act forall a b. (a -> b) -> a -> b
$ \Arg (WdExample multi)
testsession -> do

            SessionState multi
tstate <- forall multi. WdTestSession multi -> IO (SessionState multi)
wdTestOpen Arg (WdExample multi)
testsession

            Maybe WDSession
msess <- case (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup multi
multi forall a b. (a -> b) -> a -> b
$ forall multi. SessionState multi -> [(multi, WDSession)]
stSessionMap SessionState multi
tstate,
                           (forall multi. SessionState multi -> Bool
stPrevHadError SessionState multi
tstate Bool -> Bool -> Bool
|| forall multi. SessionState multi -> Bool
stPrevAborted SessionState multi
tstate) Bool -> Bool -> Bool
&& Bool
skipRemainingTestsAfterFailure) of
                (Maybe WDSession
_, Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                (Just WDSession
s, Bool
False) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just WDSession
s
                (Maybe WDSession
Nothing, Bool
False) ->
                    forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall multi. SessionState multi -> IO WDSession
stCreateSession SessionState multi
tstate
                        forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`onException` forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
testsession SessionState multi
tstate { stPrevHadError :: Bool
stPrevHadError = Bool
True }

            case Maybe WDSession
msess of
                Just WDSession
wdsession -> forall a. WDSession -> WD a -> IO a
W.runWD WDSession
wdsession forall a b. (a -> b) -> a -> b
$ do
                    -- run the example
                    Either SomeException ()
macterr <- forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try WD ()
wd
                    case Either SomeException ()
macterr of
                        Right () -> do
                            -- pass current session on to the next test
                            WDSession
wdsession' <- forall (m :: * -> *). WDSessionState m => m WDSession
W.getSession
                            let smap :: [(multi, WDSession)]
smap = (multi
multi, WDSession
wdsession') forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=multi
multi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall multi. SessionState multi -> [(multi, WDSession)]
stSessionMap SessionState multi
tstate)
                            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
testsession SessionState multi
tstate { stSessionMap :: [(multi, WDSession)]
stSessionMap = [(multi, WDSession)]
smap }

                        Left acterr :: SomeException
acterr@(SomeException e
actex) ->
                            case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
actex of
                                Just AbortSession
AbortSession -> do
                                    -- pass empty list on to the next test so the session is not closed
                                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
testsession SessionState multi
tstate { stSessionMap :: [(multi, WDSession)]
stSessionMap = [], stPrevAborted :: Bool
stPrevAborted = Bool
True }
                                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
aborted Bool
True
                                Maybe AbortSession
Nothing -> do
                                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
testsession SessionState multi
tstate { stPrevHadError :: Bool
stPrevHadError = Bool
True }
                                    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO SomeException
acterr

                Maybe WDSession
_ -> do
                    -- on error, just pass along the session and error
                    forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
prevHadError forall a b. (a -> b) -> a -> b
$ forall multi. SessionState multi -> Bool
stPrevHadError SessionState multi
tstate
                    forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
aborted forall a b. (a -> b) -> a -> b
$ forall multi. SessionState multi -> Bool
stPrevAborted SessionState multi
tstate
                    forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
testsession SessionState multi
tstate

        Bool
merr <- forall a. IORef a -> IO a
readIORef IORef Bool
prevHadError
        Bool
mabort <- forall a. IORef a -> IO a
readIORef IORef Bool
aborted
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (Bool
merr, Bool
mabort) of
            (Bool
True, Bool
_) -> [Char] -> ResultStatus -> Result
Result [Char]
"" (Maybe Location -> Maybe [Char] -> ResultStatus
Pending forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just [Char]
"Previous example had an error"))
            (Bool
_, Bool
True) -> [Char] -> ResultStatus -> Result
Result [Char]
"" (Maybe Location -> Maybe [Char] -> ResultStatus
Pending forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just [Char]
"Session has been aborted"))
            (Bool, Bool)
_ -> [Char] -> ResultStatus -> Result
Result [Char]
"" ResultStatus
Success

--------------------------------------------------------------------------------
--- Utils
--------------------------------------------------------------------------------

#if MIN_VERSION_hspec_core(2,10,0)
traverseSpec :: Applicative f => (Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec :: forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

#else
-- | Traverse a spec allowing the type to change
traverseTree :: Applicative f => (Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
traverseTree f (Leaf i) = Leaf <$> f i
traverseTree f (Node msg ss) = Node msg <$> traverse (traverseTree f) ss
#if MIN_VERSION_hspec_core(2,8,0)
traverseTree f (NodeWithCleanup loc c ss) = NodeWithCleanup loc c' <$> traverse (traverseTree f) ss
#else
traverseTree f (NodeWithCleanup c ss) = NodeWithCleanup c' <$> traverse (traverseTree f) ss
#endif
    where
        c' _b = c undefined -- this undefined is OK since we do not export the definition of WdTestSession
                            -- so the user cannot do anything with the passed in value to 'afterAll'

traverseSpec :: Applicative f => (Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec f = traverse (traverseTree f)
#endif


-- | Process the items in a depth-first walk, passing in the item counter value.
mapWithCounter :: (Int -> Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
mapWithCounter :: forall a b.
(Int -> Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
mapWithCounter Int -> Item a -> Item b
f [SpecTree a]
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState Int
0 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec Item a -> StateT Int Identity (Item b)
go [SpecTree a]
s
    where
        go :: Item a -> StateT Int Identity (Item b)
go Item a
item = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \Int
cnt -> (Int -> Item a -> Item b
f Int
cnt Item a
item, Int
cntforall a. Num a => a -> a -> a
+Int
1)

countItems :: [SpecTree a] -> Int
countItems :: forall a. [SpecTree a] -> Int
countItems [SpecTree a]
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState Int
0 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec forall {m :: * -> *} {s} {a}. (Monad m, Num s) => a -> StateT s m a
go [SpecTree a]
s
    where
        go :: a -> StateT s m a
go a
item = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \s
cnt -> (a
item, s
cntforall a. Num a => a -> a -> a
+s
1)