diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -0,0 +1,29 @@ +## 0.3.0 + +* Add support for testing multiple sessions at once + * multiSession, multiSessionWith, and runWDWith are the new functions + * the type of runWD and WDExample changed + +* Update to hspec 0.11 and webdriver 0.6 + * changed sessionOn to sessionWith to work with new webdriver WDConfig + * TestCapabilities(newCaps) changed type to @c -> IO W.Capabilities@ + +## 0.2.3 + +* Add inspectSession to assist debugging the test suite + +## 0.2.2 + +* Allow newer version of hspec + +## 0.2.1 + +* Allow newer version of hspec + +## 0.2.0 + +* Convert to use webdriver sessions + +## 0.1.0 + +* Initial Release diff --git a/Test/Hspec/WebDriver.hs b/Test/Hspec/WebDriver.hs --- a/Test/Hspec/WebDriver.hs +++ b/Test/Hspec/WebDriver.hs @@ -36,12 +36,17 @@ -- * Webdriver BrowserDefaults(..) , session - , sessionOn + , sessionWith , runWD - , WDExample - , Using(..) , inspectSession + , Using(..) + -- * Multiple sessions at once + , multiSession + , multiSessionWith + , runWDWith + , WDExample + -- * Expectations , shouldBe , shouldBeTag @@ -62,6 +67,7 @@ , parallel , pending , pendingWith + , runIO -- * Re-exports from "Test.WebDriver" , WD @@ -70,12 +76,10 @@ ) where import Control.Exception.Lifted (try, Exception, onException, throwIO, catch) -import Control.Monad (when) +import Control.Monad (when, forM_) import Control.Monad.IO.Class (liftIO) -import Data.Default (def) import Data.IORef import Data.Typeable (Typeable) -import Data.Word (Word16) import Test.HUnit (assertEqual, assertFailure) import qualified Data.Text as T @@ -86,7 +90,8 @@ import Test.WebDriver (WD) import Test.WebDriver.Commands import qualified Test.WebDriver as W -import qualified Test.WebDriver.Classes as W +import qualified Test.WebDriver.Session as W +import qualified Test.WebDriver.Config as W import qualified Test.Hspec.WebDriver.Internal as I @@ -116,7 +121,7 @@ -- should be created. class Show c => TestCapabilities c where -- | The capabilities to pass to 'createSession'. - newCaps :: c -> WD W.Capabilities + newCaps :: c -> IO W.Capabilities instance TestCapabilities BrowserDefaults where newCaps Firefox = return $ W.defaultCaps { W.browser = W.firefox } @@ -141,25 +146,89 @@ -- 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 +session = hSessionWd create + where + create :: TestCapabilities cap => cap -> IO (WdState ()) + create = createSt W.defaultConfig --- | 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 def { W.wdHost = host - , W.wdPort = port - , W.wdBasePath = bp - } +-- | 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 --- | 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. +-- | Allows testing multiple browser sessions at once. -- +-- 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. +-- +-- 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 +-- 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@). +-- +-- I use this for testing multiple users at once, with one user in each browser session. +-- +-- >data TestUser = Gandolf | Bilbo | Legolas +-- > deriving (Show, Eq, Enum, Bounded, Typeable) +-- > +-- >usersSession :: TestCapabilities cap => String -> ([cap],Spec) -> Spec +-- >usersSession = multiSession (undefined :: TestUser) +-- > +-- >runUser :: TestUser -> WD () -> WDExample TestUser +-- >runUser = runWDWith +-- > +-- >spec :: Spec +-- >spec = usersSession "tests some page" $ using Firefox $ 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@. 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 variation of 'multiSession' 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 + where + create :: (Typeable a, Eq a, TestCapabilities cap) => a -> cap -> IO (WdState a) + create _ = createSt config + +-- | 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 +-- capabilities. These psudo-caps can be passed to @using@ to convert them to a list of your actual +-- capabilities. Secondly, it allows the word @using@ to be used with 'session' so that the session +-- description reads like a sentance. +-- -- >session "for the home page" $ using Firefox $ do -- > it "loads the page" $ runWD $ do -- > ... @@ -230,8 +299,9 @@ -------------------------------------------------------------------------------- -- | State passed between examples -data WdState = WdState { - stSession :: W.WDSession -- ^ the webdriver session +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. @@ -242,47 +312,60 @@ 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 +-- | Create the internal WdState +createSt :: TestCapabilities cap => W.WDConfig -> cap -> IO (WdState a) +createSt cfg cap = do err <- newIORef False - sess' <- W.runWD sess $ newCaps cap >>= createSession - return $ WdState sess' err + caps <- newCaps cap + return $ WdState cfg { W.wdCapabilities = caps} [] err -closeSt :: WdState -> IO () -closeSt st = W.runWD (stSession st) closeSession +closeSt :: WdState a -> IO () +closeSt st = + forM_ (stSessions st) $ \(_, sess) -> + W.runWD sess 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' +hSessionWd :: (Typeable a, TestCapabilities cap) => (cap -> IO (WdState a)) -> String -> ([cap], Spec) -> Spec +hSessionWd create 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 + proc cap = mapSpecItem addCatchResult . I.session (create cap) closeSt addCatchResult item = item { -#if MIN_VERSION_hspec(1,10,0) itemExample = \p a prog -> itemExample item p a prog -#else - itemExample = \p a -> itemExample item p a -#endif `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) +-- 'runWD' or 'runWDWith'. +newtype WDExample multi = WdExample (I.SessionExample (WdState multi)) 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 +-- 'sessionWith'. +runWD :: WD () -> WDExample () +runWD = runWDWith () + +-- | 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 - w `onException` liftIO (writeIORef (stError s) True) - swd <- W.getSession - return s { stSession = swd } + 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 + + W.runWD sess $ do + w `onException` liftIO (writeIORef (stError state) True) + swd <- W.getSession + return state { stSessions = (a,swd) : filter ((/=a) . fst) (stSessions state) } diff --git a/Test/Hspec/WebDriver/Internal.hs b/Test/Hspec/WebDriver/Internal.hs --- a/Test/Hspec/WebDriver/Internal.hs +++ b/Test/Hspec/WebDriver/Internal.hs @@ -14,36 +14,45 @@ import Data.Traversable (traverse) import Data.Typeable (Typeable, cast) import Data.IORef -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec -#if MIN_VERSION_hspec(1,10,0) import Test.Hspec.Core hiding (describe, it) -#else -import Test.Hspec.Core hiding (describe, it, hspec) -#endif import qualified Control.Exception as E -#if MIN_VERSION_hspec(1,10,0) +-- | Force a spec tree to not contain any BuildSpecs +forceSpecTree :: SpecTree -> IO [SpecTree] +forceSpecTree s@(SpecItem _ _) = return [s] +forceSpecTree (SpecGroup msg ss) = do + ss' <- concat <$> mapM forceSpecTree ss + return [SpecGroup msg ss'] +forceSpecTree (BuildSpecs m) = do + trees <- m + concat <$> mapM forceSpecTree trees + +-- | Force a spec to not contain any BuildSpecs +forceSpec :: Spec -> IO [SpecTree] +forceSpec s = do + trees <- runSpecM s + concat <$> mapM forceSpecTree trees + +-- | Traverse a spec, but only if forceSpec has already been called traverseTree :: Applicative f => (Item -> f Item) -> SpecTree -> f SpecTree traverseTree f (SpecItem msg i) = SpecItem msg <$> f i traverseTree f (SpecGroup msg ss) = SpecGroup msg <$> traverse (traverseTree f) ss -#else -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 -#endif +traverseTree _ (BuildSpecs _) = error "No BuildSpecs should be left" -traverseSpec :: Applicative f => (Item -> f Item) -> Spec -> f Spec -traverseSpec f s = fromSpecList <$> traverse (traverseTree f) (runSpecM s) +-- | Traverse a list of specs, but only if forceSpecs has already been called +traverseSpec :: Applicative f => (Item -> f Item) -> [SpecTree] -> f [SpecTree] +traverseSpec f trees = traverse (traverseTree f) trees + -- | Process the items in a depth-first walk, passing in the item counter value. -mapWithCounter :: (Int -> Item -> Item) -> Spec -> Spec +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 :: Spec -> Int +countItems :: [SpecTree] -> Int countItems s = flip execState 0 $ traverseSpec go s where go item = state $ \cnt -> (item, cnt+1) @@ -155,11 +164,14 @@ -> (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 +session create close s = fromSpecList [build] + where + build = BuildSpecs $ do + trees <- forceSpec s + let cnt = countItems trees + mvars <- sequence $ take cnt $ repeat newEmptyMVar + let sess = Session cnt mvars create close + return (mapWithCounter (sessionItem sess) trees) -- | Create an example to pass to 'it' which accesses and modifies the state using the state monad. -- For example, diff --git a/hspec-webdriver.cabal b/hspec-webdriver.cabal --- a/hspec-webdriver.cabal +++ b/hspec-webdriver.cabal @@ -1,5 +1,5 @@ name: hspec-webdriver -version: 0.2.3 +version: 0.3.0 cabal-version: >= 1.8 build-type: Simple synopsis: Write end2end web application tests using webdriver and hspec @@ -16,6 +16,7 @@ with . extra-source-files: README.md + Changelog.md source-repository head type: mercurial @@ -31,11 +32,11 @@ , HUnit >= 1.2 && < 1.3 , hashable >= 1.2 - , hspec >= 1.8 + , hspec >= 1.11 , data-default >= 0.5 , lifted-base >= 0.2 , stm >= 2.4 , text >= 0.11 , transformers >= 0.3 , unordered-containers >= 0.2 - , webdriver >= 0.5 && < 0.6 + , webdriver >= 0.6 && < 0.7