packages feed

hspec-webdriver 0.3.2 → 1.0.0

raw patch · 4 files changed

+242/−337 lines, 4 filesdep +hspec-coredep ~HUnitdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec-core

Dependency ranges changed: HUnit, hspec

API changes (from Hackage documentation)

- Test.Hspec.WebDriver: data WDExample multi
- Test.Hspec.WebDriver: instance Exception PrevHasError
- Test.Hspec.WebDriver: instance Show PrevHasError
- Test.Hspec.WebDriver: instance Typeable PrevHasError
- Test.Hspec.WebDriver: instance Typeable multi => Example (WDExample multi)
- Test.Hspec.WebDriver: instance Typeable1 WdState
- Test.Hspec.WebDriver: liftIO :: MonadIO m => forall a. IO a -> m a
- Test.Hspec.WebDriver: multiSession :: (TestCapabilities cap, Typeable a, Eq a) => a -> String -> ([cap], Spec) -> Spec
- Test.Hspec.WebDriver: multiSessionWith :: (TestCapabilities cap, Typeable a, Eq a) => WDConfig -> a -> String -> ([cap], Spec) -> Spec
+ Test.Hspec.WebDriver: WdExample :: multi -> (WD ()) -> WdExample multi
+ Test.Hspec.WebDriver: WdPending :: (Maybe String) -> WdExample multi
+ Test.Hspec.WebDriver: data WdExample multi
+ Test.Hspec.WebDriver: data WdTestSession multi
+ Test.Hspec.WebDriver: example :: Default multi => Expectation -> WdExample multi
+ Test.Hspec.WebDriver: instance Eq multi => Example (WdExample multi)
+ Test.Hspec.WebDriver: instance Exception AbortSession
+ Test.Hspec.WebDriver: instance Show AbortSession
+ Test.Hspec.WebDriver: instance Typeable AbortSession
+ Test.Hspec.WebDriver: specify :: Example a => String -> a -> SpecWith (Arg a)
+ Test.Hspec.WebDriver: type SpecWith a = SpecM a ()
- Test.Hspec.WebDriver: context :: String -> Spec -> Spec
+ Test.Hspec.WebDriver: context :: String -> SpecWith a -> SpecWith a
- Test.Hspec.WebDriver: describe :: String -> Spec -> Spec
+ Test.Hspec.WebDriver: describe :: String -> SpecWith a -> SpecWith a
- Test.Hspec.WebDriver: it :: Example a => String -> a -> Spec
+ Test.Hspec.WebDriver: it :: Example a => String -> a -> SpecWith (Arg a)
- Test.Hspec.WebDriver: parallel :: Spec -> Spec
+ Test.Hspec.WebDriver: parallel :: SpecWith a -> SpecWith a
- Test.Hspec.WebDriver: pending :: Expectation
+ Test.Hspec.WebDriver: pending :: WdExample multi
- Test.Hspec.WebDriver: pendingWith :: String -> Expectation
+ Test.Hspec.WebDriver: pendingWith :: String -> WdExample multi
- Test.Hspec.WebDriver: runIO :: IO a -> SpecM a
+ Test.Hspec.WebDriver: runIO :: IO r -> SpecM a r
- Test.Hspec.WebDriver: runWD :: WD () -> WDExample ()
+ Test.Hspec.WebDriver: runWD :: WD () -> WdExample ()
- Test.Hspec.WebDriver: runWDWith :: (Eq a, Typeable a) => a -> WD () -> WDExample a
+ Test.Hspec.WebDriver: runWDWith :: multi -> WD () -> WdExample multi
- Test.Hspec.WebDriver: session :: TestCapabilities cap => String -> ([cap], Spec) -> Spec
+ Test.Hspec.WebDriver: session :: TestCapabilities cap => String -> ([cap], SpecWith (WdTestSession multi)) -> Spec
- Test.Hspec.WebDriver: sessionWith :: TestCapabilities cap => WDConfig -> String -> ([cap], Spec) -> Spec
+ Test.Hspec.WebDriver: sessionWith :: TestCapabilities cap => WDConfig -> String -> ([cap], SpecWith (WdTestSession multi)) -> Spec
- Test.Hspec.WebDriver: type Spec = SpecM ()
+ Test.Hspec.WebDriver: type Spec = SpecWith ()
- Test.Hspec.WebDriver: using :: Using a => a -> Spec -> (UsingList a, Spec)
+ Test.Hspec.WebDriver: using :: Using a => a -> SpecWith (WdTestSession multi) -> (UsingList a, SpecWith (WdTestSession multi))

Files

Changelog.md view
@@ -1,3 +1,12 @@+## 1.0.0++* Update to hspec2.  All the same features are present but some of the types changed+  to reflect hspec2 types.++## 0.3.2++* Update to the new hspec 1.12 API+ ## 0.3.1  * Convert inspectSession to turn into a pending example instead of throwing an error.
Test/Hspec/WebDriver.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, OverloadedStrings, FlexibleInstances, DeriveDataTypeable, TypeFamilies, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances, DeriveDataTypeable, TypeFamilies #-} -- | 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@@ -33,19 +33,21 @@ -- 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+  -- * Webdriver Example     BrowserDefaults(..)+  , WdExample(..)+  , runWD+  , runWDWith+  , pending+  , pendingWith+  , example++  -- * Webdriver Sessions   , session   , sessionWith-  , runWD   , inspectSession   , Using(..)--  -- * Multiple sessions at once-  , multiSession-  , multiSessionWith-  , runWDWith-  , WDExample+  , WdTestSession    -- * Expectations   , shouldBe@@ -61,30 +63,35 @@   -- * Re-exports from "Test.Hspec"   , hspec   , Spec+  , SpecWith   , describe-  , it   , context+  , it+  , specify   , parallel-  , pending-  , pendingWith   , runIO    -- * Re-exports from "Test.WebDriver"   , WD-  , liftIO   , module Test.WebDriver.Commands ) where -import Control.Exception.Lifted (try, Exception, onException, throwIO, catches, Handler(..))-import Control.Monad (when, forM_)+import Control.Applicative+import Control.Concurrent.MVar+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.Typeable (Typeable, cast) import Data.IORef-import Data.Typeable (Typeable)+import Data.Traversable (traverse) import Test.HUnit (assertEqual, assertFailure) import qualified Data.Text as T -import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow)-import Test.Hspec.Core (Result(..), Item(..), mapSpecItem)+import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow, pending, pendingWith, example)+import Test.Hspec.Core.Spec (Result(..), Item(..), Example(..), SpecTree, Tree(..), fromSpecList, runSpecM) import qualified Test.Hspec as H  import Test.WebDriver (WD)@@ -93,8 +100,6 @@ import qualified Test.WebDriver.Session as W import qualified Test.WebDriver.Config as W -import qualified Test.Hspec.WebDriver.Internal as I- -- | Webdriver expectations consist of a set of browser 'W.Capabilities' to use and the actual test as -- a 'WD' monad.  The browser capabilities are specified by an enumeration which is an instance of -- 'TestCapabilities'.  The @BrowserDefaults@ enumeration provides items that represent the default set of@@ -132,60 +137,65 @@     newCaps IPad = return $ W.defaultCaps { W.browser = W.iPad }     newCaps Android = return $ W.defaultCaps { W.browser = W.android } --- | Combine the examples nested inside this call into a webdriver session.  For each capability in--- the list, before the first example is executed, a new webdriver session is created using the--- capabilities.  The examples are then executed in depth-first order using this webdriver session--- (so later examples can rely on the browser state created by earlier examples).  Once the final--- example has executed, the session is closed.  If some 'WDExample' fails (throws an exception),--- all remaining examples in the session will become pending.------ Note that when using 'parallel', the examples within a single session will still execute--- serially.  Different sessions (including the multiple sessions created if more than one--- capability is passed to 'session') will be executed in parallel.------ This function uses the default webdriver host (127.0.0.1), port (4444), and--- basepath (@\/wd\/hub@).-session :: TestCapabilities cap => String -> ([cap], Spec) -> Spec-session = hSessionWd create-    where-        create :: TestCapabilities cap => cap -> IO (WdState ())-        create = createSt W.defaultConfig+-- | The state passed between examples inside the mvars.+data SessionState multi = SessionState {+    -- | The already created sessions+    stSessionMap :: [(multi, W.WDSession)]+    -- | True if the previous example had an error+  , stPrevHadError :: Bool+    -- | True if the previous example was aborted with 'inspectSession'+  , stPrevAborted :: Bool+    -- | Create a new session+  , stCreateSession :: IO W.WDSession+} --- | 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 'TestCapabilities'.-sessionWith :: TestCapabilities cap-            => W.WDConfig -> String -> ([cap], Spec) -> Spec-sessionWith config = hSessionWd create-    where-        create :: TestCapabilities cap => cap -> IO (WdState ())-        create = createSt config+-- | Internal state for webdriver test sessions.+data WdTestSession multi = WdTestSession {+    wdTestOpen :: IO (SessionState multi)+  , wdTestClose :: SessionState multi -> IO ()+} --- | Allows testing multiple browser sessions at once.+-- | A webdriver example. ----- The way this works is you create a type @a@ to index the sessions, pass an undefined value to--- 'multiSession', and then use values of type @a@ with 'runWDWith' to identify which session the--- example should run with.  The first time 'runWDWith' sees a value, a new session is created.  Note--- that the examples are still run serially in depth-first order.+-- 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:2+-- 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.   ----- Note that in hspec1, the requirement that every example inside 'multiSession' must use 'runWDWith'--- with the same type @a@ is not checked by types.  In <http://hackage.haskell.org/package/hspec2 hspec2>--- the types are expressive enough so that this can be checked by the type system (and also means--- 'multiSession' does not need the undefined value of type @a@).+-- 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. ----- I use this for testing multiple users at once, with one user in each browser session.+-- 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 (WD ()) | WdPending (Maybe String)++-- | 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 = 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, Typeable)--- >--- >usersSession :: TestCapabilities cap => String -> ([cap],Spec) -> Spec--- >usersSession = multiSession (undefined :: TestUser)+-- >    deriving (Show, Eq, Enum, Bounded) -- > -- >runUser :: TestUser -> WD () -> WDExample TestUser -- >runUser = runWDWith -- > -- >spec :: Spec--- >spec = usersSession "tests some page" $ using Firefox $ do+-- >spec = session "tests some page" $ using Firefox $ do -- >    it "does something with Gandolf" $ runUser Gandolf $ do -- >        openPage ... -- >    it "does something with Bilbo" $ runUser Bilbo $ do@@ -196,32 +206,58 @@ -- -- 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@.  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 'runIO' to create an--- IORef while constructing the spec.  Note this can be hidden inside the @usersSession@ function.-multiSession :: (TestCapabilities cap, Typeable a, Eq a)-             => a -- ^ Can be an undefined value of type a, this is used only to determine the type-             -> String -- ^ the message-             -> ([cap], Spec) -- ^ the list of capabilites and the spec-             -> Spec-multiSession val = hSessionWd $ create val-    where-        create :: (Typeable a, Eq a, TestCapabilities cap) => a -> cap -> IO (WdState a)-        create _ = createSt W.defaultConfig+-- 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', and then use implicit parameters to pass the IORefs between examples.+runWDWith :: multi -> WD () -> WdExample multi+runWDWith = WdExample --- | A variation of 'multiSession' which allows you to specify the webdriver configuration.  Note that+-- | A pending example.+pending :: WdExample multi+pending = WdPending Nothing++-- | A pending example with a message.+pendingWith :: String -> WdExample multi+pendingWith = WdPending . 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 = WdExample def . 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 :: TestCapabilities cap => String -> ([cap], SpecWith (WdTestSession multi)) -> Spec+session = sessionWith W.defaultConfig++-- | 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 'TestCapabilities'.-multiSessionWith :: (TestCapabilities cap, Typeable a, Eq a)-               => W.WDConfig-               -> a -- ^ Can be an undefined value of type a, this is used only to determine the type-               -> String -- ^ the message-               -> ([cap], Spec) -- ^ the list of capabilites and the spec-               -> Spec-multiSessionWith config val = hSessionWd $ create val+sessionWith :: TestCapabilities cap => W.WDConfig -> String -> ([cap], SpecWith (WdTestSession multi)) -> Spec+sessionWith cfg msg (caps, spec) = spec'     where-        create :: (Typeable a, Eq a, TestCapabilities cap) => a -> cap -> IO (WdState a)-        create _ = createSt config+        spec' = case caps of+                    [] -> it msg $ H.pendingWith "No capabilities specified"+                    [c] -> describe (msg ++ " using " ++ show c) $ procTestSession cfg c spec+                    _ -> describe msg $ mapM_ (\c -> describe ("using " ++ show c) $ procTestSession cfg c spec) caps  -- | A typeclass of things which can be converted to a list of capabilities.  It has two uses. -- First, it allows you to create a datatype of grouped capabilities in addition to your actual@@ -238,7 +274,7 @@ -- >    ... class Using a where     type UsingList a-    using :: a -> Spec -> (UsingList a, Spec)+    using :: a -> SpecWith (WdTestSession multi) -> (UsingList a, SpecWith (WdTestSession multi))  instance Using BrowserDefaults where     type UsingList BrowserDefaults = [BrowserDefaults]@@ -248,6 +284,10 @@     type UsingList [BrowserDefaults] = [BrowserDefaults]     using d s = (d, s) +data AbortSession = AbortSession+    deriving (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@@ -257,7 +297,7 @@ -- 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 = throwIO I.AbortSessionEx+inspectSession = throwIO AbortSession  -- | 'H.shouldBe' lifted into the 'WD' monad. shouldBe :: (Show a, Eq a) => a -> a -> WD ()@@ -293,82 +333,120 @@         Left err -> err `shouldBe` expected         Right _ -> liftIO $ assertFailure $ "did not get expected exception " ++ show expected - -------------------------------------------------------------------------------- -- Internal Test Runner -------------------------------------------------------------------------------- --- | State passed between examples-data WdState a = WdState {-   stInitialConfig :: W.WDConfig -- ^ initial config- , stSessions :: [(a,W.WDSession)] -- ^ the webdriver sessions- , stError :: IORef Bool    -- ^ has an error occured in an earlier example?  We rely on the serialization-                            --   of examples to ensure that at most one thread is reading/writing this-                            --   ioref.-} deriving Typeable---- | Used to signal that a previous example had an error-data PrevHasError = PrevHasError-    deriving (Show, Typeable)-instance Exception PrevHasError+-- | Create a WdTestSession.+createTestSession :: W.WDConfig -> [MVar (SessionState multi)] -> Int -> WdTestSession multi+createTestSession cfg mvars n = WdTestSession open close+    where+        open | n == 0 = return $ SessionState [] False False create+             | otherwise = takeMVar (mvars !! n) --- | Create the internal WdState-createSt :: TestCapabilities cap => W.WDConfig -> cap -> IO (WdState a)-createSt cfg cap = do-    err <- newIORef False-    caps <- newCaps cap-    return $ WdState cfg { W.wdCapabilities = caps} [] err +        create = do+            s <- W.mkSession cfg+            W.runWD s $ createSession $ W.wdCapabilities cfg -closeSt :: WdState a -> IO ()-closeSt st = -    forM_ (stSessions st) $ \(_, sess) ->-        W.runWD sess closeSession+        close st | length mvars - 1 == n = mapM_ ((`W.runWD` closeSession) . snd) $ stSessionMap st+                 | otherwise = putMVar (mvars !! (n + 1)) st --- | The 'WDSession' passed in is used for its host, port, and base path.-hSessionWd :: (Typeable a, TestCapabilities cap) => (cap -> IO (WdState a)) -> String -> ([cap], Spec) -> Spec-hSessionWd create msg (caps, spec) = spec'+-- | 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 cfg mvars n item = item { itemExample = \p act progress -> itemExample item p (act . act') progress }     where-        spec' = case caps of-                    [] -> it msg $ pendingWith "No capabilities specified"-                    [c] -> describe (msg ++ " using " ++ show c) $ proc c spec-                    _ -> describe msg $ mapM_ (\c -> describe ("using " ++ show c) $ proc c spec) caps+        act' f () = f (createTestSession cfg mvars n) -        proc cap = mapSpecItem addCatchResult . I.session (create cap) closeSt+-- | Convert a spec tree of test items to a spec tree of generic items by creating a single session for +-- the entire tree.+procTestSession :: TestCapabilities cap+                => W.WDConfig -> cap -> SpecWith (WdTestSession multi) -> Spec+procTestSession cfg c s = do+    (mvars, cap, trees) <- runIO $ do+        cap <- newCaps c+        trees <- runSpecM s+        let cnt = countItems trees+        mvars <- replicateM cnt newEmptyMVar+        return (mvars, cap, trees)+    +    fromSpecList $ mapWithCounter (procSpecItem cfg {W.wdCapabilities = cap} mvars) trees -        addCatchResult item = item {-            itemExample = \p a prog -> itemExample item p a prog-                                    `catches` [ Handler $ \PrevHasError -> return $ Pending $ Just "previous example had error" -                                              , Handler $ \I.AbortSessionEx -> return $ Pending $ Just "Session Aborted"-                                              ]-            }+instance Eq multi => Example (WdExample multi) where+    type Arg (WdExample multi) = WdTestSession multi+    evaluateExample (WdPending msg) _ _ _ = return $ Pending msg+    evaluateExample (WdExample multi wd) _ act _ = do+        prevHadError <- newIORef False+        aborted <- newIORef False --- | An example that can be passed to 'it' containing a webdriver action.  It must be created with--- 'runWD' or 'runWDWith'.-newtype WDExample multi = WdExample (I.SessionExample (WdState multi))-    deriving Example+        act $ \testsession -> do --- | Create an example from a 'WD' action.  This /must/ be nested inside a call to 'session' or--- 'sessionWith'.-runWD :: WD () -> WDExample ()-runWD = runWDWith ()+            tstate <- wdTestOpen testsession --- | Create an example from a 'WD' action, parameterized by which session to run.--- This /must/ be nested inside a call to 'multiSession' or 'multiSessionWith' and can only be used--- when multiple sessions are running.  Also, the type @a@ must match the type given to--- 'multiSession'.-runWDWith :: (Eq a, Typeable a) => a -> WD () -> WDExample a-runWDWith a w = WdExample $ I.SessionExample $ \state -> do-    err <- readIORef $ stError state-    when err $ throwIO PrevHasError+            msess <- case (lookup multi $ stSessionMap tstate, stPrevHadError tstate, stPrevAborted tstate) of+                (_, True, _) -> return Nothing+                (_, _, True) -> return Nothing+                (Just s, False, False) -> return $ Just s+                (Nothing, False, False) ->+                    Just <$> stCreateSession tstate+                        `onException` wdTestClose testsession tstate { stPrevHadError = True } -    sess <- case lookup a (stSessions state) of-                Just s -> return s-                Nothing -> do-                    let cfg = stInitialConfig state-                    s <- W.mkSession cfg-                    W.runWD s $ W.createSession $ W.wdCapabilities cfg+            case msess of+                Just wdsession -> W.runWD wdsession $ do+                    -- run the example+                    macterr <- try wd+                    case macterr of+                        Right () -> do+                            -- pass current session on to the next test+                            wdsession' <- W.getSession+                            let smap = (multi, wdsession') : filter ((/=multi) . fst) (stSessionMap tstate)+                            liftIO $ wdTestClose testsession tstate { stSessionMap = smap } -    W.runWD sess $ do-        w `onException` liftIO (writeIORef (stError state) True)-        swd <- W.getSession-        return state { stSessions = (a,swd) : filter ((/=a) . fst) (stSessions state) }+                        Left acterr@(SomeException actex) ->+                            case cast actex of+                                Just AbortSession -> do+                                    -- pass empty list on to the next test so the session is not closed+                                    liftIO $ wdTestClose testsession tstate { stSessionMap = [], stPrevAborted = True }+                                    liftIO $ writeIORef aborted True+                                Nothing -> do+                                    liftIO $ wdTestClose testsession tstate { stPrevHadError = True }+                                    throwIO acterr++                _ -> do+                    -- on error, just pass along the session and error+                    writeIORef prevHadError $ stPrevHadError tstate+                    writeIORef aborted $ stPrevAborted tstate+                    wdTestClose testsession tstate++        merr <- readIORef prevHadError+        mabort <- readIORef aborted+        return $ case (merr, mabort) of+            (True, _) -> Pending (Just "Previous example had an error")+            (_, True) -> Pending (Just "Session has been aborted")+            _ -> Success++--------------------------------------------------------------------------------+--- Utils+--------------------------------------------------------------------------------++-- | 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+traverseTree f (NodeWithCleanup c ss) = NodeWithCleanup c' <$> traverse (traverseTree f) ss+    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)++-- | 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 f s = flip evalState 0 $ traverseSpec go s+    where+        go item = state $ \cnt -> (f cnt item, cnt+1)++countItems :: [SpecTree a] -> Int+countItems s = flip execState 0 $ traverseSpec go s+    where+        go item = state $ \cnt -> (item, cnt+1)
− Test/Hspec/WebDriver/Internal.hs
@@ -1,182 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable, RankNTypes, FlexibleContexts, ScopedTypeVariables  #-}-module Test.Hspec.WebDriver.Internal (-  -- * State Sessions-    session-  , runState-  , with-  , SessionExample(..)-  , AbortSessionEx(..)-) where--import Control.Applicative-import Control.Concurrent.MVar-import Control.Monad (replicateM)-import Control.Monad.Trans.State (state, evalState, execState, execStateT, StateT)-import Data.Traversable (traverse)-import Data.Typeable (Typeable, cast)-import Data.IORef-import Test.Hspec-import Test.Hspec.Core hiding (describe, it)--import qualified Control.Exception as E---- | Traverse a spec, but only if forceSpec has already been called-traverseTree :: Applicative f => (Item -> f Item) -> SpecTree -> f SpecTree-traverseTree f (SpecItem i) = SpecItem <$> f i-traverseTree f (SpecGroup msg ss) = SpecGroup msg <$> traverse (traverseTree f) ss-traverseTree f (SpecWithCleanup c ss) = SpecWithCleanup c <$> traverse (traverseTree f) ss---- | Traverse a list of specs, but only if forceSpecs has already been called-traverseSpec :: Applicative f => (Item -> f Item) -> [SpecTree] -> f [SpecTree]-traverseSpec f = traverse (traverseTree f)---- | Process the items in a depth-first walk, passing in the item counter value.-mapWithCounter :: (Int -> Item -> Item) -> [SpecTree] -> [SpecTree]-mapWithCounter f s = flip evalState 0 $ traverseSpec go s-    where-        go item = state $ \cnt -> (f cnt item, cnt+1)--countItems :: [SpecTree] -> Int-countItems s = flip execState 0 $ traverseSpec go s-    where-        go item = state $ \cnt -> (item, cnt+1)--data AbortSessionEx = AbortSessionEx-    deriving Typeable-instance E.Exception AbortSessionEx-instance Show AbortSessionEx where-    show AbortSessionEx = "Session Aborted"--data SessionTest a = SessionTest (IO () -> IO ()) (a -> IO a)-    deriving Typeable-instance Show (SessionTest a) where-    show _ = "Test must be contained within a session of matching state type"-instance Typeable a => E.Exception (SessionTest a)---- | A session example, which contains an expectation and also transforms the state.--- @SessionExample@s must be located as a child to a call to 'session' and the type @s@ must match between--- the example and the call to 'session'.  Sessions cannot be nested, so if there is no parent call--- to 'session' or the types @s@ do not match, the example will fail.-data SessionExample s = SessionExample (s -> IO s)-instance Typeable a => Example (SessionExample a) where-    evaluateExample (SessionExample f) _ act _ = E.throwIO $ SessionTest act f--data Session a = Session {-    sessionCount :: Int-  , sessionMVars :: [MVar (Either E.SomeException a)]-  , sessionCreate :: IO a-  , sessionClose :: a -> IO ()-}--sessionItem :: Typeable a => Session a -> Int -> Item -> Item-sessionItem sess i item =-        item { itemExample = \p a prog -> runTest $ itemExample item p a prog }-    where-        open | i == 0 = E.try $ sessionCreate sess-             | otherwise = takeMVar $ sessionMVars sess !! i--        close ma | i == sessionCount sess - 1 = either (const $ return ()) (sessionClose sess) ma-                 | otherwise = putMVar (sessionMVars sess !! (i+1)) ma--        runTest ex = do-            ma <- open-            mres <- E.try ex-            case mres of-                -- normal, non-session test.  Use the original state ma for the next test.-                Right res -> close ma >> return res--                Left (E.SomeException err) ->-                    case (ma, cast err) of-                        -- non-session test threw an error (since the cast to SessionTest-                        -- failed).  Use the original state ma for the next test and rethrow the-                        -- error.-                        (_, Nothing) -> close ma >> E.throwIO err--                        -- A session test, where in addition the open function succeeded.-                        (Right a, Just (SessionTest act f)) -> do-                            aborted <- newIORef False-                            act $ do-                                mstate <- E.try $ f a-                                case mstate of-                                    -- pass new state to next test-                                    Right st -> close (Right st)-                                    Left serr@(E.SomeException actErr) ->-                                        case cast actErr of-                                            -- pass abort to next test-                                            Just AbortSessionEx -> close (Left serr) >> writeIORef aborted True-                                            -- pass original state and rethrow the error-                                            Nothing -> close ma >> E.throwIO serr-                            abrt <- readIORef aborted-                            return $ if abrt then Pending (Just "Session Aborted") else Success-                            -                        -- A session test where the state ma is an error (which is the error-                        -- thrown by open).  Pass the error ma to the next test and throw the-                        -- error.-                        (Left err', _) -> close ma >> E.throwIO err'---- | This function causes all child examples (sessions cannot be nested) to be executed serially in--- depth-first order, tracking a state of type @s@ throughout the examples as they are processed in--- order.  Examples which are 'SessionExample's (which are essentially functions @s -> IO s@) can view--- and modify the state.------ * If an example is not a 'SessionExample', the example is executed and there is no change in the--- state.------ * If an example is a 'SessionExample' but throws an exception, there is no change in the state.------ * If an example is a 'SessionExample' and completes successfully, the state returned from the--- example is used as the new state.------ Just before the first example is run, the create action is executed to obtain the initial state.--- If the create action throws an error, all of the child 'SessionExample' will report this error.--- Once the final example is run, the cleanup action is executed with the current state (which is--- the intial state passed through all successful examples).  An exception in the cleanup function--- is ignored.------ If you use 'parallel', the child examples in the session will still be executed serially in--- depth-first order so that the state is processed through properly.  But multiple sessions will be--- executed in parallel.-session :: Typeable s => IO s -- ^ create the state-                      -> (s -> IO ()) -- ^ cleanup the state-                      -> Spec -- ^ spec tree to process-                      -> Spec-session create close s = do-    (sess, trees) <- runIO $ do-        trees <- runSpecM s-        let cnt = countItems trees-        mvars <- replicateM cnt newEmptyMVar-        return (Session cnt mvars create close, trees)-    fromSpecList (mapWithCounter (sessionItem sess) trees)---- | Create an example to pass to 'it' which accesses and modifies the state using the state monad.--- For example,------ >it "checks the state" $ runState $ do--- >    s <- get--- >    liftIO $ s `shouldBe` "Hello, World"-runState :: StateT s IO () -> SessionExample s-runState = SessionExample . execStateT---- | Create an example to pass to 'it' which only reads the state.  This is useful for bracketing--- tests with some resource.  For example,------ >openDb :: IO DbConnection--- >openDb = ...--- >--- >closeDb :: DbConnection -> IO ()--- >closeDb = ...--- >--- >dbSessionWhich :: String -> Spec -> Spec--- >dbSessionWhich msg = session openDb closeDb . describe msg--- >--- >spec :: Spec--- >spec = --- >  ...--- >  dbSessionWhich "checks users" $ do--- >      it "adds a user" $ with $ \db -> do--- >          ... something with db ...--- >--- >      it "loads the user" $ with $ \db -> do--- >          ... something with db ...-with :: (s -> IO ()) -> SessionExample s-with f = SessionExample $ \a -> f a >> return a
hspec-webdriver.cabal view
@@ -1,5 +1,5 @@ name:              hspec-webdriver-version:           0.3.2+version:           1.0.0 cabal-version:     >= 1.8 build-type:        Simple synopsis:          Write end2end web application tests using webdriver and hspec@@ -25,15 +25,15 @@ library     hs-source-dirs:  .     exposed-modules:  Test.Hspec.WebDriver-    other-modules: Test.Hspec.WebDriver.Internal     ghc-options:   -Wall -O2      build-depends: base                 >= 4          && < 5 -                 , HUnit                >= 1.2-                 , hashable             >= 1.2-                 , hspec                >= 1.12 && < 1.13+                 , HUnit                >= 1.2 && < 1.3                  , data-default         >= 0.5+                 , hashable             >= 1.2+                 , hspec-core           >= 2.0 && < 2.1+                 , hspec                >= 2.0 && < 2.1                  , lifted-base          >= 0.2                  , stm                  >= 2.4                  , text                 >= 0.11