hspec-webdriver 0.1.0 → 0.2.0
raw patch · 3 files changed
+307/−306 lines, 3 files
Files
- Test/Hspec/WebDriver.hs +167/−113
- Test/Hspec/WebDriver/Internal.hs +139/−192
- hspec-webdriver.cabal +1/−1
Test/Hspec/WebDriver.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, DeriveDataTypeable, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances, DeriveDataTypeable, TypeFamilies, GeneralizedNewtypeDeriving #-} -- | 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@@ -13,30 +13,33 @@ -- >main :: IO () -- >main = hspec $ -- > describe "XKCD Tests" $ do--- > it "checks hover text of 327" $ using Firefox $ do--- > openPage "http://www.xkcd.com/327/"--- > 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 $ it "checks title of 303" $ using [Firefox, Chrome] $ do--- > openPage "http://www.xkcd.com/303/"--- > e <- findElem $ ById "ctitle"--- > e `shouldBeTag` "div"--- > e `shouldHaveText` "Compiling"+-- > session "for 327" $ using Firefox $ 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.") -- >--- > it "checks image of 1310" pending+-- > parallel $ session "for 303" $ using [Firefox, Chrome] $ 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). You can configure this using `createSessionManager'`. +-- @\/wd\/hub@ (this is the default). module Test.Hspec.WebDriver( -- * Webdriver BrowserDefaults(..)- , it+ , session+ , sessionOn+ , runWD+ , WDExample , Using(..)- , pending- , pendingWith- , WdExpectation(..) -- * Expectations , shouldBe@@ -46,140 +49,135 @@ , shouldReturn , shouldThrow - -- * Session Manager- , createSessionManager- , createSessionManager'- -- * Custom Capabilities , TestCapabilities(..) - -- * Re-exports from hspec+ -- * Re-exports from "Test.Hspec" , hspec , Spec , describe+ , it , context , parallel- -- $beforeTodo+ , pending+ , pendingWith -- * Re-exports from "Test.WebDriver" , WD , liftIO , module Test.WebDriver.Commands-- -- * Internal- , withCaps ) where -import Control.Exception.Lifted (try, Exception)+import Control.Exception.Lifted (try, Exception, onException, throwIO, catch)+import Control.Monad (when) import Control.Monad.IO.Class (liftIO)+import Data.IORef import Data.Typeable (Typeable)+import Data.Word (Word16) import Test.HUnit (assertEqual, assertFailure)-import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow, it, pending, pendingWith)-import Test.Hspec.Core (Result(..), fromSpecList, SpecTree(..), Item(..), Params)-import Test.WebDriver hiding (Browser(..))+import qualified Data.Text as T++import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow)+import Test.Hspec.Core (Result(..), Item(..), mapSpecItem)+import qualified Test.Hspec as H++import Test.WebDriver (WD) import Test.WebDriver.Commands import qualified Test.WebDriver as W-import qualified Test.Hspec as H-import qualified Data.Text as T+import qualified Test.WebDriver.Classes as W -import Test.Hspec.WebDriver.Internal+import qualified Test.Hspec.WebDriver.Internal as I --- | Webdriver expectations consist of a set of browser 'Capabilities' to use and the actual test as--- a 'W.WD' monad. The browser capabilities are specified by an enumeration which is an instance of+-- | 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--- capabilities for each browser. When creating new sessions, the 'defaultCaps' are used. Also,--- any existing session (which exists at program startup) which matches the browser is used, no--- matter the actual capabilities.+-- capabilities for each browser (see 'W.defaultCaps'). -- -- To obtain more control over the capabilities (e.g. to test multiple versions of IE or to test -- Firefrox without javascript), you should @import Test.Hspec.WebDriver hiding (BrowserDefaults)@ -- and then create your own enumeration which is an instance of 'TestCapabilities' and 'Using'. data BrowserDefaults = Firefox | Chrome | IE | Opera | IPhone | IPad | Android- deriving (Eq, Show, Enum, Bounded, Typeable)--instance TestCapabilities BrowserDefaults where- matchesCaps Firefox (Capabilities { browser = W.Firefox _ _ _ }) = True- matchesCaps Chrome (Capabilities { browser = W.Chrome _ _ _ _ }) = True- matchesCaps IE (Capabilities { browser = W.IE _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ }) = True- matchesCaps Opera (Capabilities { browser = W.Opera _ _ _ _ _ _ _ _ _ _ _ _ }) = True- matchesCaps IPhone (Capabilities { browser = W.IPhone}) = True- matchesCaps IPad (Capabilities { browser = W.IPad }) = True- matchesCaps Android (Capabilities { browser = W.Android }) = True- matchesCaps _ _ = False+ deriving (Eq, Show, Enum, Bounded) - newCaps Firefox = return $ defaultCaps { browser = firefox }- newCaps Chrome = return $ defaultCaps { browser = chrome }- newCaps IE = return $ defaultCaps { browser = ie }- newCaps Opera = return $ defaultCaps { browser = opera }- newCaps IPhone = return $ defaultCaps { browser = iPhone }- newCaps IPad = return $ defaultCaps { browser = iPad }- newCaps Android = return $ defaultCaps { browser = android }+-- | Provides information about the browser capabilities used for testing. If you want more control+-- over capabilities, you should hide 'BrowserDefaults' and then make an enumeration of all the+-- webdriver capabilities you will be testing with. For example,+--+-- >data TestCaps = Firefox+-- > | FirefoxWithoutJavascript+-- > | Chrome+-- > | IE8+-- > | IE9+-- > deriving (Show, Eq, Bounded, Enum)+--+-- @TestCaps@ must then be made an instance of @TestCapabilities@. Also, instances of @Using@+-- should be created.+class Show c => TestCapabilities c where+ -- | The capabilities to pass to 'createSession'.+ newCaps :: c -> WD W.Capabilities --- | A webdriver expectation is either an action and a list of capabilities (which should be an instance of--- 'TestCapabilities') or a pending message.-data WdExpectation cap = WdTest [cap] (WD ())- | WdPending (Maybe String)+instance TestCapabilities BrowserDefaults where+ newCaps Firefox = return $ W.defaultCaps { W.browser = W.firefox }+ newCaps Chrome = return $ W.defaultCaps { W.browser = W.chrome }+ newCaps IE = return $ W.defaultCaps { W.browser = W.ie }+ newCaps Opera = return $ W.defaultCaps { W.browser = W.opera }+ newCaps IPhone = return $ W.defaultCaps { W.browser = W.iPhone }+ newCaps IPad = return $ W.defaultCaps { W.browser = W.iPad }+ newCaps Android = return $ W.defaultCaps { W.browser = W.android } --- | Evaluate an expectation to a list of the function expected by hspec.-evaluateWd :: (Show cap, TestCapabilities cap) => WdExpectation cap -> [(String,Params -> (IO () -> IO ()) -> IO Result)]-evaluateWd (WdPending msg) = [("", \_ _ -> return $ Pending msg)]-evaluateWd (WdTest cs test) = map mkItem cs- where- mkItem c = ("using " ++ show c, eval c)+-- | 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 W.defaultSession - eval :: TestCapabilities c => c -> params -> (IO () -> IO ()) -> IO Result- eval c _ action = do action (runWD defaultSession $ withCaps c test)- return Success+-- | A variation of 'session' which allows you to specify the webdriver host, port, and basepath.+sessionOn :: TestCapabilities cap+ => String -- ^ host+ -> Word16 -- ^ port+ -> String -- ^ base path+ -> String -- ^ message+ -> ([cap], Spec)+ -> Spec+sessionOn host port bp = hSessionWd W.WDSession { W.wdHost = host+ , W.wdPort = port+ , W.wdBasePath = bp+ , W.wdSessId = Nothing+ , W.lastHTTPRequest = Nothing+ } --- | A typeclass of things which can be converted to a 'WdExpectation'. This is the primary method--- to create expectations to pass to 'it'. Both a single 'BrowserDefaults' and a list--- of 'BrowserDefaults' can be used.+-- | A typeclass of things which can be converted to a list of capabilities. It's primary purpose+-- is to allow the word @using@ to be used with 'session' so that the session description reads like+-- a sentance. ----- >it "opens the home page" $ using Firefox $ do--- > ...--- >it "opens the users page" $ using [Firefox, Chrome] $ do+-- >session "for the home page" $ using Firefox $ do+-- > it "loads the page" $ runWD $ do+-- > ...+-- > it "scrolls the carosel" $ runWD $ do+-- > ...+-- >session "for the users page" $ using [Firefox, Chrome] $ do -- > ... class Using a where- type UsingCapabilities a :: *- using :: a -> WD () -> WdExpectation (UsingCapabilities a)+ type UsingList a+ using :: a -> Spec -> (UsingList a, Spec) instance Using BrowserDefaults where- type UsingCapabilities BrowserDefaults = BrowserDefaults- using d = WdTest [d]+ type UsingList BrowserDefaults = [BrowserDefaults]+ using d s = ([d], s) instance Using [BrowserDefaults] where- type UsingCapabilities [BrowserDefaults] = BrowserDefaults- using = WdTest---- | Create a spec from a webdriver expectation.------ The webdriver expectation consists of a list of browser capabilities and the actual test. The--- test will be executed once for each set of capabilities in the list. By default, the tests will be--- executed serially. You can use 'parallel' to execute the test on all capabilities in parallel.------ To run the test, a webdriver session is allocated from a pool of sessions (in a thread-safe--- manner). The pools will be initialized automatically from existing sessions the first time a--- test is run; you can explicitly create the pools using 'createSessionManager'.-it :: (Show cap, TestCapabilities cap) => String -> WdExpectation cap -> Spec-it msg a = spec- where- mkItem m f = SpecItem Item { itemIsParallelizable = False- , itemRequirement = m- , itemExample = f- }- spec = case evaluateWd a of- [] -> fromSpecList []- [("",f)] -> fromSpecList [mkItem (msg) f]- [(m,f)] -> fromSpecList [mkItem (msg ++ " " ++ m) f]- ss -> describe msg $ fromSpecList $ map (uncurry mkItem) ss---- | A 'WdExpectation' that is pending.-pending :: WdExpectation ()-pending = WdPending Nothing---- | A 'WdExpectation' that is pending, with a message.-pendingWith :: String -> WdExpectation ()-pendingWith = WdPending . Just+ type UsingList [BrowserDefaults] = [BrowserDefaults]+ using d s = (d, s) -- | 'H.shouldBe' lifted into the 'WD' monad. shouldBe :: (Show a, Eq a) => a -> a -> WD ()@@ -215,5 +213,61 @@ Left err -> err `shouldBe` expected Right _ -> liftIO $ assertFailure $ "did not get expected exception " ++ show expected --- $beforeTodo--- Future TODO: lift 'before', 'after', and 'around' into the 'WD' monad.++--------------------------------------------------------------------------------+-- Internal Test Runner+--------------------------------------------------------------------------------++-- | State passed between examples+data WdState = WdState {+ stSession :: W.WDSession -- ^ the webdriver session+ , 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++-- | The initial session is used only for its host, port, and basepath. A new session is created.+createSt :: TestCapabilities cap => W.WDSession -> cap -> IO WdState+createSt sess cap = do+ err <- newIORef False+ sess' <- W.runWD sess $ newCaps cap >>= createSession+ return $ WdState sess' err++closeSt :: WdState -> IO ()+closeSt st = W.runWD (stSession st) closeSession++-- | The 'WDSession' passed in is used for its host, port, and base path.+hSessionWd :: TestCapabilities cap => W.WDSession -> String -> ([cap], Spec) -> Spec+hSessionWd sess msg (caps, spec) = spec'+ 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++ proc cap = mapSpecItem addCatchResult . I.session (createSt sess cap) closeSt++ addCatchResult item = item {+ itemExample = \p a -> itemExample item p a+ `catch` \PrevHasError -> return $ Pending $ Just "previous example had error" }++-- | An example that can be passed to 'it' containing a webdriver action. It must be created with+-- 'runWD'.+newtype WDExample = WdExample (I.SessionExample WdState)+ deriving Example++-- | Create an example from a 'WD' action. This /must/ be nested inside a call to 'session' or+-- 'sessionOn'.+runWD :: WD () -> WDExample+runWD w = WdExample $ I.SessionExample $ \s -> W.runWD (stSession s) $ do+ err <- liftIO $ readIORef $ stError s+ when err $ throwIO PrevHasError++ w `onException` liftIO (writeIORef (stError s) True)+ swd <- W.getSession+ return s { stSession = swd }
Test/Hspec/WebDriver/Internal.hs view
@@ -1,213 +1,160 @@-{-# LANGUAGE ExistentialQuantification #-}-module Test.Hspec.WebDriver.Internal(- TestCapabilities(..)- , createSessionManager- , createSessionManager'- , withCaps+{-# LANGUAGE DeriveDataTypeable, RankNTypes, FlexibleContexts, ScopedTypeVariables #-}+module Test.Hspec.WebDriver.Internal (+ -- * State Sessions+ session+ , runState+ , with+ , SessionExample(..) ) where -import Control.Concurrent.STM-import Control.Exception.Lifted (finally, onException)-import Control.Monad.IO.Class (liftIO)-import Data.Hashable-import Data.List (partition)-import Data.Maybe (fromJust)-import Data.Typeable-import Data.Word (Word16)+import Control.Applicative+import Control.Concurrent.MVar+import Control.Monad.Trans.State (state, evalState, execState, execStateT, StateT)+import Data.Traversable (traverse)+import Data.Typeable (Typeable(..), cast) import System.IO.Unsafe (unsafePerformIO)-import Test.WebDriver-import Test.WebDriver.Classes-import qualified Data.HashMap.Lazy as M+import Test.Hspec+import Test.Hspec.Core hiding (describe, it, hspec) --- | Provides information about the browser capabilities used for testing. If you want more control--- over capabilities, you should hide @BrowserDefaults@ and then make--- an enumeration of all the webdriver capabilities you will be testing with. For example,------ >data TestCaps = Firefox--- > | FirefoxWithoutJavascript--- > | Chrome--- > | IE8--- > | IE9--- > deriving (Show, Eq, Bounded, Enum, Typeable)------ @TestCaps@ must then be made an instance of @TestCapabilities@. Also, instances of @Using@--- should be created.-class (Eq c, Enum c, Typeable c) => TestCapabilities c where+import qualified Control.Exception as E - -- | Check if the 'Capabilities' match your enumeration. Note that these capabilities- -- will be the actual capabilities (with things like version information filled in)- -- so you should not use @==@ to compare capabilities, only check the actual capabilities you- -- care about.- matchesCaps :: c -> Capabilities -> Bool+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 - -- | The capabilities to pass to 'createSession' when no existing session is found.- newCaps :: c -> WD Capabilities+traverseSpec :: Applicative f => (Item -> f Item) -> Spec -> f Spec+traverseSpec f s = fromSpecList <$> traverse (traverseTree f) (runSpecM s) --- | This instance is used for pending messages, no capabilities are matched or created.-instance TestCapabilities () where- matchesCaps () _ = False- newCaps () = error "Cannot create caps for ()"+-- | Process the items in a depth-first walk, passing in the item counter value.+mapWithCounter :: (Int -> Item -> Item) -> Spec -> Spec+mapWithCounter f s = flip evalState 0 $ traverseSpec go s+ where+ go item = state $ \cnt -> (f cnt item, cnt+1) -data SomeCap = forall c. TestCapabilities c => SomeCap c+countItems :: Spec -> Int+countItems s = flip execState 0 $ traverseSpec go s+ where+ go item = state $ \cnt -> (item, cnt+1) -instance Eq SomeCap where- SomeCap c1 == SomeCap c2 = case cast c2 of- Just c2' -> c1 == c2'- Nothing -> False -instance Hashable SomeCap where- hashWithSalt i (SomeCap c) = hashUsing fromEnum i c+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) -data ManagedSessions = ManagedSessions- { maxSessions :: Int- -- ^ maximum number of sessions that should be created- , managedSessions :: M.HashMap SomeCap (TVar ([SessionId],Int))- -- ^ For each cap, store the list of unused sessions and a count of in-use sessions.- , initialSessions :: [(SessionId,Capabilities)]- -- ^ sessions which existed at program start and are not yet assigned.+-- | 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 - -- | settings for session- , mwdHost :: String- , mwdPort :: Word16- , mwdBasePath :: String- }+data Session a = Session {+ sessionCount :: Int+ , sessionMVars :: [MVar (Either E.SomeException a)]+ , sessionCreate :: IO a+ , sessionClose :: a -> IO ()+} --- | Stores the managed sessions-sessionManager :: TVar (Maybe ManagedSessions)-{-# NOINLINE sessionManager #-}-sessionManager = unsafePerformIO (newTVarIO Nothing)+sessionItem :: Typeable a => Session a -> Int -> Item -> Item+sessionItem sess i item = item { itemExample = \p a -> runTest $ itemExample item p a }+ where+ open | i == 0 = E.try $ sessionCreate sess+ | otherwise = takeMVar $ sessionMVars sess !! i --- | Create and set the session manager-createWdMan :: Int -> Maybe (String, Word16, String) -> WD ()-createWdMan maxSess mSettings = do- let (host,port,bpath) = case mSettings of- Just s -> s- Nothing -> (wdHost defaultSession, wdPort defaultSession, wdBasePath defaultSession)- sess <- sessions+ close ma | i == sessionCount sess - 1 = either (const $ return ()) (sessionClose sess) ma+ | otherwise = putMVar (sessionMVars sess !! (i+1)) ma - let manager = ManagedSessions maxSess M.empty sess host port bpath+ 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 - liftIO $ atomically $ do- mm <- readTVar sessionManager- case mm of- Just _ -> return () -- manager has already been created- Nothing -> writeTVar sessionManager $ Just manager+ Left (E.SomeException err) -> do+ 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 --- | Create a new session manager using the default webdriver host (127.0.0.1), port (4444), and--- basepath (@\/wd\/hub@).+ -- A session test, where in addition the open function succeeded.+ (Right a, Just (SessionTest act f)) -> do+ act $ do+ a' <- f a + `E.onException` close ma -- use old state on error+ close $ Right a' -- use new state+ return 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. ----- The session manager hands out sessions to tests (in a thread-safe manner). Threads ask for--- sessions by an enumeration which is an instance of 'TestCapabilities', and the manager stores a--- pool of sessions for each enumeration item. When calling 'createSessionManager', the already--- existing sessions are loaded and used as the initial sessions in the pools. If a thread asks for--- a session but none is available, one of two things happens: if the total number of sessions for--- this enumeration item is larger than the argument to 'createSessionManager', the thread will--- block until a session is available. If the total number of sessions for this enumeration item is--- smaller, a new session will be created. This is only relevant if you run tests in parallel,--- since when running tests serially at most one session will be in use at any one time in any case.--- Note that sessions are never closed by the manager.+-- * If an example is not a 'SessionExample', the example is executed and there is no change in the+-- state. ----- If you do not call 'createSessionManager', when the very first test is run a new manager will be--- created where the maximum number of sessions per enumeration item is one.-createSessionManager :: Int -- ^ threshold number of sessions per enumeration item beyond which new - -- sessions are no longer created. Note you can set this to zero so- -- that new sessions are never created; the only sessions used will be- -- those that already exist.- -> IO ()-createSessionManager maxSess = runWD defaultSession $ createWdMan maxSess Nothing---- | Same as 'createSessionManager' but allows you to specify the webdriver host, port, and base--- path for all sessions.-createSessionManager' :: Int -- ^ threshold number of sessions per enumeration item- -> String -- ^ host- -> Word16 -- ^ port- -> String -- ^ base path- -> IO ()-createSessionManager' maxSess host port bpath = do- let sess = WDSession { wdHost = host- , wdPort = port- , wdBasePath = bpath- , wdSessId = Nothing- , lastHTTPRequest = Nothing- }- runWD sess $ createWdMan maxSess $ Just (host, port, bpath)---- | Create a session-createSessionId :: SomeCap -> WD SessionId-createSessionId (SomeCap c) = do- caps <- newCaps c- sess <- createSession caps- return $ fromJust $ wdSessId sess---- | Searches for a session. Returns the action to be used to obtain the session.-findSession :: SomeCap -> ManagedSessions -> STM (WD SessionId)-findSession sc@(SomeCap c) m =- case M.lookup sc $ managedSessions m of- Just tvar -> do- (sess,count) <- readTVar tvar- case sess of- (s:ss) -> do writeTVar tvar (ss, count + 1)- return $ return s-- [] | count >= maxSessions m -> retry -- retry blocks until a tvar changes-- | otherwise -> do writeTVar tvar ([], count + 1)- let create = createSessionId sc `onException` (liftIO $ atomically $ do- (s',cnt) <- readTVar tvar- writeTVar tvar (s', cnt - 1))- return create-- Nothing -> do- let (sess, unmanaged') = partition (\(_,cap) -> matchesCaps c cap) $ initialSessions m- tvar <- newTVar (map fst sess, 0)- let m' = m { initialSessions = unmanaged'- , managedSessions = M.insert sc tvar $ managedSessions m- }- writeTVar sessionManager $ Just m'- findSession sc m'---- | Take a session out of the pool, using an existing unused session, creating a new session, or--- blocking if the maximum number of sessions already exist. The new session is set into the 'WD'--- monad. Note the session can leak if you do not properly call 'putSessionId'.-takeSession :: TestCapabilities s => s -> WD ()-takeSession s = do- msess <- liftIO $ atomically $ do- mm <- readTVar sessionManager- case mm of- Nothing -> return Nothing- Just m -> do r <- findSession (SomeCap s) m- return $ Just (r, mwdHost m, mwdPort m, mwdBasePath m)- case msess of- Just (r, host, port, bpath) -> do- let sess = WDSession { wdHost = host- , wdPort = port- , wdBasePath = bpath- , wdSessId = Nothing- , lastHTTPRequest = Nothing- }- putSession sess- sid <- r- putSession sess { wdSessId = Just sid }-- Nothing -> do- createWdMan 1 Nothing- takeSession s+-- * 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 = unsafePerformIO $ do+ let cnt = countItems s+ mvars <- sequence $ take cnt $ repeat newEmptyMVar+ let sess = Session cnt mvars create close+ return $ mapWithCounter (sessionItem sess) s --- | Add a session ID back into the pool.-putSessionId :: TestCapabilities s => s -> SessionId -> WD ()-putSessionId s sid = liftIO $ atomically $ do- mm <- readTVar sessionManager- let m = maybe (error "Cannot put a session to an uninitialized manager") id mm- case M.lookup (SomeCap s) $ managedSessions m of- Nothing -> error "Cannot put a session to a cap that does not exist"- Just tvar -> do- (ss,cnt) <- readTVar tvar- writeTVar tvar (sid:ss,cnt-1)+-- | 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 --- | Find or create a new session, set it into the 'WD' monad, run the given action, and return the--- session back into the pool once the action completes or an exception occurs.-withCaps :: TestCapabilities s => s -> WD a -> WD a-withCaps tc test = do- takeSession tc- sess <- getSession- test `finally` putSessionId tc (fromJust $ wdSessId sess)+-- | 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.1.0+version: 0.2.0 cabal-version: >= 1.8 build-type: Simple synopsis: Write end2end web application tests using webdriver and hspec