webdriver 0.5.5 → 0.6
raw patch · 16 files changed
+656/−487 lines, 16 filesdep +http-clientdep +http-typesdep −HTTP
Dependencies added: http-client, http-types
Dependencies removed: HTTP
Files
- CHANGELOG.md +13/−2
- README.md +78/−0
- src/Test/WebDriver.hs +1/−1
- src/Test/WebDriver/Class.hs +74/−0
- src/Test/WebDriver/Classes.hs +0/−195
- src/Test/WebDriver/Commands.hs +103/−104
- src/Test/WebDriver/Commands/Internal.hs +5/−4
- src/Test/WebDriver/Commands/Wait.hs +11/−8
- src/Test/WebDriver/Config.hs +74/−0
- src/Test/WebDriver/Internal.hs +129/−126
- src/Test/WebDriver/Monad.hs +23/−23
- src/Test/WebDriver/Session.hs +115/−0
- src/Test/WebDriver/Types.hs +7/−4
- src/Test/WebDriver/Utils.hs +3/−3
- test/search-baidu.hs +3/−3
- webdriver.cabal +17/−14
CHANGELOG.md view
@@ -1,7 +1,18 @@ #Change Log+##0.6+* Rather than WDSession serving dual roles as configuration and state, its functionality has been split into 2 respective types: WDConfig and WDSession.+* runSession now takes a WDConfig instead of WDSession and Capabilities parameters.+* runSession no longer closes its session on successful completion; use finallyClose or closeOnException for this behavior+* The old Test.WebDriver.Classes module has been split into Test.WebDriver.Session and Test.WebDriver.Class+* SessionState typeclass renamed to WDSessionState+* We now use the http-client package instead of HTTP. This is reflected in the addition of Manager fields in both WDConfig and WDSession++##0.5.5+* Added optional HTTP history tracking for debugging purposes.+ ##0.5.4-* MonadCatchIO is deprecated in favour of exceptions-* Relaxed dependencies on mtl, network and scientific+* MonadCatchIO is deprecated in favour of exceptions.+* Relaxed dependencies on mtl, network and scientific. ##0.5.3.3 * Relaxed text dependency up to 1.2
README.md view
@@ -40,6 +40,83 @@ For more build options, please refer to the Cabal documentation. ++#Getting Started+WebDriver is a client-server protocol. Since hs-webdriver only implements a WebDriver client, in order to make use of this library you must have a WebDriver server that you can connect to.++##Using the Selenium stand-alone server+While you can use any WebDriver server out there, probably the simplest server to use with hs-webdriver is the Java stand-alone server. This server is cross-platform and works with every major browser. Head over to http://docs.seleniumhq.org/download/ and download the latest version of Selenium Server. Next, run the Java jar; in a POSIX shell, this should look something like:++ java -jar selenium-server-standalone-X.X.X.jar++The server should now be up and running at localhost on port 4444.++##Hello, World!+With the Selenium server running locally, you're ready to write browser automation scripts in Haskell. Let's start with a simple example.+```hs+ {-# LANGUAGE OverloadedStrings #-}+ import Test.WebDriver+ + myConfig :: WDConfig+ myConfig = defaultConfig+ + main :: IO ()+ main = runSession config $ do+ openPage "http://google.com"+ searchInput <- findElem (ByCSS "input[type='text']")+ sendKeys "Hello, World!" searchInput+```+hs-webdriver uses a very simple EDSL implemented within a state monad. Interacting with the remote browser is done via a sequence of commands within this monad. The state monad maintains implicit information about the WebDriver session between commands, so that individual commands only need to specify parameters relevant to the action they perform. If you're new to monads, there are plenty of resources available for learning on the web, but for now you can think of the `WD` monad as a very simple imperative language operating on an implicitly defined session object.++Let's take a closer look at each piece of this example.++###Demonic invocations: a bit of boilerplate++ {-# LANGUAGE OverloadedStrings #-}++hs-webdriver uses the `Text` type to represent Unicode character sequences, which is significantly more efficient than the standard Haskell implementation for Unicode strings. This directive tells GHC to overload string literals so that they can be used to represent `Text` values.++ import Test.WebDriver++This line is fairly straightforward; we need to import the library so that we can use it! Most of the basic API is available through the `Test.WebDriver` module, so this is the only import you should need for most tests. There are other modules that may be of interest for advanced usage; in particular, `Test.WebDriver.Commands.Wait` provides so-called "implicit waits" as defined by other WebDriver libraries.++###Configuring a WebDriver session++ myConfig :: WDConfig+ myConfig = defaultConfig+ +To configure a new WebDriver session, we use the `WDConfig` type; this is a record type with various configuration fields. To connect to the Selenium server that we spawned earlier, the `defaultConfig` is sufficient. By default, the browser is set to Firefox, but that can be changed; the following configuration will use Google Chrome instead of Firefox for our test:++ myConfig :: WDConfig+ myConfig = defaultConfig { wdCapabilities = chrome }+ +###Initializing tests++ main :: IO ()+ main = runSession config $ do++`main` is the standard entry point for a Haskell program, defined as a value of type `IO a`. In order to transform our `WD` action into an `IO` action, we use the `runSession` function, which has the type:++ runSession :: WDConfig -> WD a -> IO a+ +So we pass to `runSession` our configuration record along with a WebDriver "script" to perform, and it transforms the script into a side-effectful `IO` action. The `WDConfig` record is used to automatically initialize our session with the remote server.++NOTE: `runSession` does not automatically close the session it creates. This is intentional, as you may want to manually inspect the browser state after your code executes. If you want to have the session automatically close, you can use the `finallyClose` function to provide this behavior.++ main = runSession config . finallyClose $ do+++###Actually writing tests!++ openPage "http://google.com"+ searchInput <- findElem (ByCSS "input[type='text']")+ sendKeys "Hello, World!" searchInput++Interaction with the browser is accomplished via WebDriver "commands", which are just function calls within the `WD` monad. Most of these commands are defined in the `Test.WebDriver.Commands` modules, and are fairly self-explanatory. In this example, `openPage` opens a new URL, and `findElem` searches for a DOM element on the current page which matches the given selector (possible selectors include `ById`, `ByName`, `ByClass`, `ByTag`, `ByLinkText`, `ByCSS`, and `ByXPath`). The DOM Element found by the result of the search is bound to the local variable `searchInput`, and `sendKeys` sends a sequence of emulated keystrokes to the given element.++This example contains all of the basic elements of a simple WebDriver test. For complete documentation on each command, check out the documentation for `Test.WebDriver.Commands` (see [#Documentation](Documentation)).++ #Documentation Documentation for hs-webdriver is available on Hackage at <http://hackage.haskell.org/package/webdriver>. However, here's how to generate local HTML documentation from this source revision:@@ -49,3 +126,4 @@ ``` Haddock will generate documentation and save it in dist/doc/html/webdriver+
src/Test/WebDriver.hs view
@@ -4,7 +4,7 @@ -} module Test.WebDriver ( -- * WebDriver sessions- WD(..), WDSession(..), defaultSession, SessionId(..)+ WD(..), WDConfig(..), defaultConfig -- * Running WebDriver tests , runWD, runSession, withSession, finallyClose, closeOnException, dumpSessionHistory -- * WebDriver commands
+ src/Test/WebDriver/Class.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts,+ GeneralizedNewtypeDeriving, RecordWildCards #-}+module Test.WebDriver.Class+ ( -- * WebDriver class+ WebDriver(..), Method, methodDelete, methodGet, methodPost,+ ) where+import Test.WebDriver.Session ++import Data.Aeson+import Data.Text (Text)++import Network.HTTP.Types.Method (methodDelete, methodGet, methodPost, Method)++import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Identity+import Control.Monad.List+import Control.Monad.Reader+import Control.Monad.Error+--import Control.Monad.Cont+import Control.Monad.Writer.Strict as SW+import Control.Monad.Writer.Lazy as LW+import Control.Monad.State.Strict as SS+import Control.Monad.State.Lazy as LS+import Control.Monad.RWS.Strict as SRWS+import Control.Monad.RWS.Lazy as LRWS++++ + -- |A class for monads that can handle wire protocol requests. This is the+-- operation underlying all of the high-level commands exported in+-- "Test.WebDriver.Commands". For more information on the wire protocol see+-- <http://code.google.com/p/selenium/wiki/JsonWireProtocol>+class (WDSessionState wd) => WebDriver wd where+ doCommand :: (ToJSON a, FromJSON b) =>+ Method -- ^HTTP request method+ -> Text -- ^URL of request+ -> a -- ^JSON parameters passed in the body+ -- of the request. Note that, as a special case,+ -- anything that converts to Data.Aeson.Null will+ -- result in an empty request body.+ -> wd b -- ^The JSON result of the HTTP request.++instance WebDriver wd => WebDriver (SS.StateT s wd) where+ doCommand rm t a = lift (doCommand rm t a)+ +instance WebDriver wd => WebDriver (LS.StateT s wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance WebDriver wd => WebDriver (MaybeT wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance WebDriver wd => WebDriver (IdentityT wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance (Monoid w, WebDriver wd) => WebDriver (LW.WriterT w wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance WebDriver wd => WebDriver (ReaderT r wd) where+ doCommand rm t a = lift (doCommand rm t a)++instance (Error e, WebDriver wd) => WebDriver (ErrorT e wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance (Monoid w, WebDriver wd) => WebDriver (SRWS.RWST r w s wd) where+ doCommand rm t a = lift (doCommand rm t a)++instance (Monoid w, WebDriver wd) => WebDriver (LRWS.RWST r w s wd) where+ doCommand rm t a = lift (doCommand rm t a)
− src/Test/WebDriver/Classes.hs
@@ -1,195 +0,0 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts,- GeneralizedNewtypeDeriving #-}-module Test.WebDriver.Classes- ( -- * WebDriver class- WebDriver(..), RequestMethod(..),- -- * SessionState class- SessionState(..), modifySession- -- ** WebDriver sessions- , WDSession(..), lastHTTPRequest, SessionId(..), defaultSession- ) where----import Test.WebDriver.Internal-import Data.Aeson-import Data.Maybe-import Network.HTTP (RequestMethod(..))-import Network.HTTP.Base (Request, Response)-import Data.ByteString.Lazy (ByteString)--import Data.Text (Text)--import Control.Monad.Trans.Control-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Identity-import Control.Monad.List-import Control.Monad.Reader-import Control.Monad.Error---import Control.Monad.Cont-import Control.Monad.Writer.Strict as SW-import Control.Monad.Writer.Lazy as LW-import Control.Monad.State.Strict as SS-import Control.Monad.State.Lazy as LS-import Control.Monad.RWS.Strict as SRWS-import Control.Monad.RWS.Lazy as LRWS--import Data.Default-import Data.Word----- |A class for monads that carry a WebDriver session with them. The--- MonadBaseControl superclass is used for exception handling through--- the lifted-base package.-class MonadBaseControl IO s => SessionState s where- getSession :: s WDSession- putSession :: WDSession -> s ()---- |A class for monads that can handle wire protocol requests. This is the--- operation underlying all of the high-level commands exported in--- "Test.WebDriver.Commands". For more information on the wire protocol see--- <http://code.google.com/p/selenium/wiki/JsonWireProtocol>-class SessionState wd => WebDriver wd where- doCommand :: (ToJSON a, FromJSON b) =>- RequestMethod -- ^HTTP request method- -> Text -- ^URL of request- -> a -- ^JSON parameters passed in the body- -- of the request. Note that, as a special case,- -- anything that converts to Data.Aeson.Null will- -- result in an empty request body.- -> wd b -- ^The JSON result of the HTTP request.--modifySession :: SessionState s => (WDSession -> WDSession) -> s ()-modifySession f = getSession >>= putSession . f--{- |Information about a WebDriver session. This structure is passed-implicitly through all 'WD' computations, and is also used to configure the 'WD'-monad before execution. -}-data WDSession = WDSession {- -- |Host name of the WebDriver server for this- -- session (default 127.0.0.1)- wdHost :: String- -- |Port number of the server (default 4444)- , wdPort :: Word16- -- |Base path (default "/wd/hub")- , wdBasePath :: String- -- |An opaque reference identifying the session to- -- use with 'WD' commands.- -- A value of Nothing indicates that a session- -- hasn't been created yet.- -- Sessions can be created within 'WD' via- -- 'Test.WebDriver.createSession', or created- -- and closed automatically with- -- 'Test.WebDriver.runSession'- , wdSessId :: Maybe SessionId- -- |The complete history of HTTP requests and- -- responses (updated in 'doCommand', most recent- -- first).- , wdSessHist :: [(Request ByteString, Response ByteString)]- -- |If 'wdKeepSessHist' is 'True', 'wdSessHist'- -- contains the full session history.- -- Otherwise, only the last request/response- -- pair is stored (O(1) heap consumption).- , wdKeepSessHist :: Bool- } deriving (Show)---- |The last HTTP request issued by this session, if any.-lastHTTPRequest :: WDSession -> Maybe (Request ByteString)-lastHTTPRequest = fmap fst . listToMaybe . wdSessHist--instance Default WDSession where- def = WDSession { wdHost = "127.0.0.1"- , wdPort = 4444- , wdBasePath = "/wd/hub"- , wdSessId = Nothing- , wdSessHist = []- , wdKeepSessHist = False- }--{- |A default session connects to localhost on port 4444, and hasn't been-initialized server-side. This value is the same as 'def' but with a less-polymorphic type. -}-defaultSession :: WDSession-defaultSession = def---{- |An opaque identifier for a WebDriver session. These handles are produced by-the server on session creation, and act to identify a session in progress. -}-newtype SessionId = SessionId Text- deriving (Eq, Ord, Show, Read,- FromJSON, ToJSON)---instance SessionState m => SessionState (LS.StateT s m) where- getSession = lift getSession- putSession = lift . putSession--instance WebDriver wd => WebDriver (LS.StateT s wd) where- doCommand rm t a = lift (doCommand rm t a)---instance SessionState m => SessionState (SS.StateT s m) where- getSession = lift getSession- putSession = lift . putSession--instance WebDriver wd => WebDriver (SS.StateT s wd) where- doCommand rm t a = lift (doCommand rm t a)--instance SessionState m => SessionState (MaybeT m) where- getSession = lift getSession- putSession = lift . putSession--instance WebDriver wd => WebDriver (MaybeT wd) where- doCommand rm t a = lift (doCommand rm t a)---instance SessionState m => SessionState (IdentityT m) where- getSession = lift getSession- putSession = lift . putSession--instance WebDriver wd => WebDriver (IdentityT wd) where- doCommand rm t a = lift (doCommand rm t a)---instance (Monoid w, SessionState m) => SessionState (LW.WriterT w m) where- getSession = lift getSession- putSession = lift . putSession--instance (Monoid w, WebDriver wd) => WebDriver (LW.WriterT w wd) where- doCommand rm t a = lift (doCommand rm t a)---instance SessionState m => SessionState (ReaderT r m) where- getSession = lift getSession- putSession = lift . putSession--instance WebDriver wd => WebDriver (ReaderT r wd) where- doCommand rm t a = lift (doCommand rm t a)---instance (Error e, SessionState m) => SessionState (ErrorT e m) where- getSession = lift getSession- putSession = lift . putSession--instance (Error e, WebDriver wd) => WebDriver (ErrorT e wd) where- doCommand rm t a = lift (doCommand rm t a)----instance SessionState m => SessionState (ContT r m) where--- getSession = lift getSession--- putSession = lift . putSession----instance WebDriver wd => WebDriver (ContT r wd) where--- doCommand rm t a = lift (doCommand rm t a)--instance (Monoid w, SessionState m) => SessionState (SRWS.RWST r w s m) where- getSession = lift getSession- putSession = lift . putSession--instance (Monoid w, WebDriver wd) => WebDriver (SRWS.RWST r w s wd) where- doCommand rm t a = lift (doCommand rm t a)---instance (Monoid w, SessionState m) => SessionState (LRWS.RWST r w s m) where- getSession = lift getSession- putSession = lift . putSession--instance (Monoid w, WebDriver wd) => WebDriver (LRWS.RWST r w s wd) where- doCommand rm t a = lift (doCommand rm t a)
src/Test/WebDriver/Commands.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ExistentialQuantification,- TemplateHaskell #-}+ TemplateHaskell, RecordWildCards #-} -- |This module exports basic WD actions that can be used to interact with a -- browser session. module Test.WebDriver.Commands@@ -74,7 +74,8 @@ ) where import Test.WebDriver.Commands.Internal-import Test.WebDriver.Classes+import Test.WebDriver.Class+import Test.WebDriver.Session import Test.WebDriver.JSON import Test.WebDriver.Capabilities import Test.WebDriver.Internal@@ -99,12 +100,9 @@ import qualified Control.Exception.Lifted as L import Data.Word import Data.String (fromString)-import Data.Maybe (fromMaybe)+import Data.Maybe import qualified Data.Char as C --- -- |Convenience function to handle webdriver commands with no return value noReturn :: WebDriver wd => wd NoReturn -> wd () noReturn = void@@ -116,31 +114,32 @@ -- |Create a new session with the given 'Capabilities'. createSession :: WebDriver wd => Capabilities -> wd WDSession createSession caps = do- ignoreReturn . doCommand POST "/session" . single "desiredCapabilities" $ caps+ ignoreReturn . doCommand methodPost "/session" . single "desiredCapabilities" $ caps getSession -- |Retrieve a list of active sessions and their 'Capabilities'. sessions :: WebDriver wd => wd [(SessionId, Capabilities)] sessions = do- objs <- doCommand GET "/sessions" Null+ objs <- doCommand methodGet "/sessions" Null forM objs $ parsePair "id" "capabilities" "sessions" -- |Get the actual 'Capabilities' of the current session. getCaps :: WebDriver wd => wd Capabilities-getCaps = doSessCommand GET "" Null+getCaps = doSessCommand methodGet "" Null -- |Close the current session and the browser associated with it. closeSession :: WebDriver wd => wd ()-closeSession = do s <- getSession- noReturn $ doSessCommand DELETE "" Null+closeSession = do s@WDSession {..} <- getSession+ noReturn $ doSessCommand methodDelete "" Null putSession s { wdSessId = Nothing } + -- |Sets the amount of time we implicitly wait when searching for elements. setImplicitWait :: WebDriver wd => Integer -> wd () setImplicitWait ms =- noReturn $ doSessCommand POST "/timeouts/implicit_wait" (object msField)+ noReturn $ doSessCommand methodPost "/timeouts/implicit_wait" (object msField) `L.catch` \(_ :: SomeException) ->- doSessCommand POST "/timeouts" (object allFields)+ doSessCommand methodPost "/timeouts" (object allFields) where msField = ["ms" .= ms] allFields = ["type" .= ("implicit" :: String)] ++ msField @@ -148,39 +147,39 @@ -- result. setScriptTimeout :: WebDriver wd => Integer -> wd () setScriptTimeout ms =- noReturn $ doSessCommand POST "/timeouts/async_script" (object msField)+ noReturn $ doSessCommand methodPost "/timeouts/async_script" (object msField) `L.catch` \( _ :: SomeException) ->- doSessCommand POST "/timeouts" (object allFields)+ doSessCommand methodPost "/timeouts" (object allFields) where msField = ["ms" .= ms] allFields = ["type" .= ("script" :: String)] ++ msField -- |Sets the amount of time to wait for a page to finish loading before throwing a 'Timeout' exception setPageLoadTimeout :: WebDriver wd => Integer -> wd ()-setPageLoadTimeout ms = noReturn $ doSessCommand POST "/timeouts" params+setPageLoadTimeout ms = noReturn $ doSessCommand methodPost "/timeouts" params where params = object ["type" .= ("page load" :: String) ,"ms" .= ms ] -- |Gets the URL of the current page. getCurrentURL :: WebDriver wd => wd String-getCurrentURL = doSessCommand GET "/url" Null+getCurrentURL = doSessCommand methodGet "/url" Null -- |Opens a new page by the given URL. openPage :: WebDriver wd => String -> wd () openPage url- | isURI url = noReturn . doSessCommand POST "/url" . single "url" $ url+ | isURI url = noReturn . doSessCommand methodPost "/url" . single "url" $ url | otherwise = throwIO . InvalidURL $ url -- |Navigate forward in the browser history. forward :: WebDriver wd => wd ()-forward = noReturn $ doSessCommand POST "/forward" Null+forward = noReturn $ doSessCommand methodPost "/forward" Null -- |Navigate backward in the browser history. back :: WebDriver wd => wd ()-back = noReturn $ doSessCommand POST "/back" Null+back = noReturn $ doSessCommand methodPost "/back" Null -- |Refresh the current page refresh :: WebDriver wd => wd ()-refresh = noReturn $ doSessCommand POST "/refresh" Null+refresh = noReturn $ doSessCommand methodPost "/refresh" Null -- |An existential wrapper for any 'ToJSON' instance. This allows us to pass -- parameters of many different types to Javascript code.@@ -208,7 +207,7 @@ executeJS :: (WebDriver wd, FromJSON a) => [JSArg] -> Text -> wd a executeJS a s = fromJSON' =<< getResult where- getResult = doSessCommand POST "/execute" . pair ("args", "script") $ (a,s)+ getResult = doSessCommand methodPost "/execute" . pair ("args", "script") $ (a,s) {- |Executes a snippet of Javascript code asynchronously. This function works similarly to 'executeJS', except that the Javascript is passed a callback@@ -220,7 +219,7 @@ asyncJS :: (WebDriver wd, FromJSON a) => [JSArg] -> Text -> wd (Maybe a) asyncJS a s = handle timeout $ Just <$> (fromJSON' =<< getResult) where- getResult = doSessCommand POST "/execute_async" . pair ("args", "script")+ getResult = doSessCommand methodPost "/execute_async" . pair ("args", "script") $ (a,s) timeout (FailedCommand Timeout _) = return Nothing timeout (FailedCommand ScriptTimeout _) = return Nothing@@ -232,22 +231,22 @@ -- |Grab a screenshot as a base-64 encoded PNG image. This is the protocol-defined format. screenshotBase64 :: WebDriver wd => wd LBS.ByteString-screenshotBase64 = TL.encodeUtf8 <$> doSessCommand GET "/screenshot" Null+screenshotBase64 = TL.encodeUtf8 <$> doSessCommand methodGet "/screenshot" Null availableIMEEngines :: WebDriver wd => wd [Text]-availableIMEEngines = doSessCommand GET "/ime/available_engines" Null+availableIMEEngines = doSessCommand methodGet "/ime/available_engines" Null activeIMEEngine :: WebDriver wd => wd Text-activeIMEEngine = doSessCommand GET "/ime/active_engine" Null+activeIMEEngine = doSessCommand methodGet "/ime/active_engine" Null checkIMEActive :: WebDriver wd => wd Bool-checkIMEActive = doSessCommand GET "/ime/activated" Null+checkIMEActive = doSessCommand methodGet "/ime/activated" Null activateIME :: WebDriver wd => Text -> wd ()-activateIME = noReturn . doSessCommand POST "/ime/activate" . single "engine"+activateIME = noReturn . doSessCommand methodPost "/ime/activate" . single "engine" deactivateIME :: WebDriver wd => wd ()-deactivateIME = noReturn $ doSessCommand POST "/ime/deactivate" Null+deactivateIME = noReturn $ doSessCommand methodPost "/ime/deactivate" Null -- |Specifies the frame used by 'Test.WebDriver.Commands.focusFrame'@@ -270,45 +269,45 @@ -- |Switch focus to the frame specified by the FrameSelector. focusFrame :: WebDriver wd => FrameSelector -> wd ()-focusFrame s = noReturn $ doSessCommand POST "/frame" . single "id" $ s+focusFrame s = noReturn $ doSessCommand methodPost "/frame" . single "id" $ s -- |Returns a handle to the currently focused window getCurrentWindow :: WebDriver wd => wd WindowHandle-getCurrentWindow = doSessCommand GET "/window_handle" Null+getCurrentWindow = doSessCommand methodGet "/window_handle" Null -- |Returns a list of all windows available to the session windows :: WebDriver wd => wd [WindowHandle]-windows = doSessCommand GET "/window_handles" Null+windows = doSessCommand methodGet "/window_handles" Null focusWindow :: WebDriver wd => WindowHandle -> wd ()-focusWindow w = noReturn $ doSessCommand POST "/window" . single "name" $ w+focusWindow w = noReturn $ doSessCommand methodPost "/window" . single "name" $ w -- |Closes the given window closeWindow :: WebDriver wd => WindowHandle -> wd ()-closeWindow = noReturn . doSessCommand DELETE "/window" . single "name"+closeWindow = noReturn . doSessCommand methodDelete "/window" . single "name" -- |Maximizes the current window if not already maximized maximize :: WebDriver wd => wd ()-maximize = noReturn $ doWinCommand GET currentWindow "/maximize" Null+maximize = noReturn $ doWinCommand methodGet currentWindow "/maximize" Null -- |Get the dimensions of the current window. getWindowSize :: WebDriver wd => wd (Word, Word)-getWindowSize = doWinCommand GET currentWindow "/size" Null+getWindowSize = doWinCommand methodGet currentWindow "/size" Null >>= parsePair "width" "height" "getWindowSize" -- |Set the dimensions of the current window. setWindowSize :: WebDriver wd => (Word, Word) -> wd ()-setWindowSize = noReturn . doWinCommand POST currentWindow "/size"+setWindowSize = noReturn . doWinCommand methodPost currentWindow "/size" . pair ("width", "height") -- |Get the coordinates of the current window. getWindowPos :: WebDriver wd => wd (Int, Int)-getWindowPos = doWinCommand GET currentWindow "/position" Null+getWindowPos = doWinCommand methodGet currentWindow "/position" Null >>= parsePair "x" "y" "getWindowPos" -- |Set the coordinates of the current window. setWindowPos :: WebDriver wd => (Int, Int) -> wd ()-setWindowPos = noReturn . doWinCommand POST currentWindow "/position" . pair ("x","y")+setWindowPos = noReturn . doWinCommand methodPost currentWindow "/position" . pair ("x","y") -- |Cookies are delicious delicacies. When sending cookies to the server, a value -- of Nothing indicates that the server should use a default value. When receiving@@ -356,33 +355,33 @@ -- |Retrieve all cookies visible to the current page. cookies :: WebDriver wd => wd [Cookie]-cookies = doSessCommand GET "/cookie" Null+cookies = doSessCommand methodGet "/cookie" Null -- |Set a cookie. If the cookie path is not specified, it will default to \"/\". -- Likewise, if the domain is omitted, it will default to the current page's -- domain setCookie :: WebDriver wd => Cookie -> wd ()-setCookie = noReturn . doSessCommand POST "/cookie" . single "cookie"+setCookie = noReturn . doSessCommand methodPost "/cookie" . single "cookie" -- |Delete a cookie. This will do nothing is the cookie isn't visible to the -- current page. deleteCookie :: WebDriver wd => Cookie -> wd ()-deleteCookie c = noReturn $ doSessCommand DELETE ("/cookie/" `append` urlEncode (cookName c)) Null+deleteCookie c = noReturn $ doSessCommand methodDelete ("/cookie/" `append` urlEncode (cookName c)) Null deleteCookieByName :: WebDriver wd => Text -> wd ()-deleteCookieByName n = noReturn $ doSessCommand DELETE ("/cookie/" `append` n) Null+deleteCookieByName n = noReturn $ doSessCommand methodDelete ("/cookie/" `append` n) Null -- |Delete all visible cookies on the current page. deleteVisibleCookies :: WebDriver wd => wd ()-deleteVisibleCookies = noReturn $ doSessCommand DELETE "/cookie" Null+deleteVisibleCookies = noReturn $ doSessCommand methodDelete "/cookie" Null -- |Get the current page source getSource :: WebDriver wd => wd Text-getSource = doSessCommand GET "/source" Null+getSource = doSessCommand methodGet "/source" Null -- |Get the title of the current page. getTitle :: WebDriver wd => wd Text-getTitle = doSessCommand GET "/title" Null+getTitle = doSessCommand methodGet "/title" Null -- |Specifies element(s) within a DOM tree using various selection methods. data Selector = ById Text@@ -412,94 +411,94 @@ -- |Find an element on the page using the given element selector. findElem :: WebDriver wd => Selector -> wd Element-findElem = doSessCommand POST "/element"+findElem = doSessCommand methodPost "/element" -- |Find all elements on the page matching the given selector. findElems :: WebDriver wd => Selector -> wd [Element]-findElems = doSessCommand POST "/elements"+findElems = doSessCommand methodPost "/elements" -- |Return the element that currently has focus. activeElem :: WebDriver wd => wd Element-activeElem = doSessCommand POST "/element/active" Null+activeElem = doSessCommand methodPost "/element/active" Null -- |Search for an element using the given element as root. findElemFrom :: WebDriver wd => Element -> Selector -> wd Element-findElemFrom e = doElemCommand POST e "/element"+findElemFrom e = doElemCommand methodPost e "/element" -- |Find all elements matching a selector, using the given element as root. findElemsFrom :: WebDriver wd => Element -> Selector -> wd [Element]-findElemsFrom e = doElemCommand POST e "/elements"+findElemsFrom e = doElemCommand methodPost e "/elements" -- |Describe the element. Returns a JSON object whose meaning is currently -- undefined by the WebDriver protocol. elemInfo :: WebDriver wd => Element -> wd Value-elemInfo e = doElemCommand GET e "" Null+elemInfo e = doElemCommand methodGet e "" Null -- |Click on an element. click :: WebDriver wd => Element -> wd ()-click e = noReturn $ doElemCommand POST e "/click" Null+click e = noReturn $ doElemCommand methodPost e "/click" Null -- |Submit a form element. This may be applied to descendents of a form element -- as well. submit :: WebDriver wd => Element -> wd ()-submit e = noReturn $ doElemCommand POST e "/submit" Null+submit e = noReturn $ doElemCommand methodPost e "/submit" Null -- |Get all visible text within this element. getText :: WebDriver wd => Element -> wd Text-getText e = doElemCommand GET e "/text" Null+getText e = doElemCommand methodGet e "/text" Null -- |Send a sequence of keystrokes to an element. All modifier keys are released -- at the end of the function. For more information about modifier keys, see -- <http://code.google.com/p/selenium/wiki/JsonWireProtocol#/session/:sessionId/element/:id/value> sendKeys :: WebDriver wd => Text -> Element -> wd ()-sendKeys t e = noReturn . doElemCommand POST e "/value" . single "value" $ [t]+sendKeys t e = noReturn . doElemCommand methodPost e "/value" . single "value" $ [t] -- |Similar to sendKeys, but doesn't implicitly release modifier keys -- afterwards. This allows you to combine modifiers with mouse clicks. sendRawKeys :: WebDriver wd => Text -> Element -> wd ()-sendRawKeys t e = noReturn . doElemCommand POST e "/keys" . single "value" $ [t]+sendRawKeys t e = noReturn . doElemCommand methodPost e "/keys" . single "value" $ [t] -- |Return the tag name of the given element. tagName :: WebDriver wd => Element -> wd Text-tagName e = doElemCommand GET e "/name" Null+tagName e = doElemCommand methodGet e "/name" Null -- |Clear a textarea or text input element's value. clearInput :: WebDriver wd => Element -> wd ()-clearInput e = noReturn $ doElemCommand POST e "/clear" Null+clearInput e = noReturn $ doElemCommand methodPost e "/clear" Null -- |Determine if the element is selected. isSelected :: WebDriver wd => Element -> wd Bool-isSelected e = doElemCommand GET e "/selected" Null+isSelected e = doElemCommand methodGet e "/selected" Null -- |Determine if the element is enabled. isEnabled :: WebDriver wd => Element -> wd Bool-isEnabled e = doElemCommand GET e "/enabled" Null+isEnabled e = doElemCommand methodGet e "/enabled" Null -- |Determine if the element is displayed. isDisplayed :: WebDriver wd => Element -> wd Bool-isDisplayed e = doElemCommand GET e "/displayed" Null+isDisplayed e = doElemCommand methodGet e "/displayed" Null -- |Retrieve the value of an element's attribute attr :: WebDriver wd => Element -> Text -> wd (Maybe Text)-attr e t = doElemCommand GET e ("/attribute/" `append` urlEncode t) Null+attr e t = doElemCommand methodGet e ("/attribute/" `append` urlEncode t) Null -- |Retrieve the value of an element's computed CSS property cssProp :: WebDriver wd => Element -> Text -> wd (Maybe Text)-cssProp e t = doElemCommand GET e ("/css/" `append` urlEncode t) Null+cssProp e t = doElemCommand methodGet e ("/css/" `append` urlEncode t) Null -- |Retrieve an element's current position. elemPos :: WebDriver wd => Element -> wd (Int, Int)-elemPos e = doElemCommand GET e "/location" Null >>= parsePair "x" "y" "elemPos"+elemPos e = doElemCommand methodGet e "/location" Null >>= parsePair "x" "y" "elemPos" -- |Retrieve an element's current size. elemSize :: WebDriver wd => Element -> wd (Word, Word)-elemSize e = doElemCommand GET e "/size" Null+elemSize e = doElemCommand methodGet e "/size" Null >>= parsePair "width" "height" "elemSize" infix 4 <==> -- |Determines if two element identifiers refer to the same element. (<==>) :: WebDriver wd => Element -> Element -> wd Bool-e1 <==> (Element e2) = doElemCommand GET e1 ("/equals/" `append` urlEncode e2) Null+e1 <==> (Element e2) = doElemCommand methodGet e1 ("/equals/" `append` urlEncode e2) Null -- |Determines if two element identifiers refer to different elements. infix 4 </=>@@ -522,41 +521,41 @@ -- |Get the current screen orientation for rotatable display devices. getOrientation :: WebDriver wd => wd Orientation-getOrientation = doSessCommand GET "/orientation" Null+getOrientation = doSessCommand methodGet "/orientation" Null -- |Set the current screen orientation for rotatable display devices. setOrientation :: WebDriver wd => Orientation -> wd ()-setOrientation = noReturn . doSessCommand POST "/orientation" . single "orientation"+setOrientation = noReturn . doSessCommand methodPost "/orientation" . single "orientation" -- |Get the text of an alert dialog. getAlertText :: WebDriver wd => wd Text-getAlertText = doSessCommand GET "/alert_text" Null+getAlertText = doSessCommand methodGet "/alert_text" Null -- |Sends keystrokes to Javascript prompt() dialog. replyToAlert :: WebDriver wd => Text -> wd ()-replyToAlert = noReturn . doSessCommand POST "/alert_text" . single "text"+replyToAlert = noReturn . doSessCommand methodPost "/alert_text" . single "text" -- |Accepts the currently displayed alert dialog. acceptAlert :: WebDriver wd => wd ()-acceptAlert = noReturn $ doSessCommand POST "/accept_alert" Null+acceptAlert = noReturn $ doSessCommand methodPost "/accept_alert" Null -- |Dismisses the currently displayed alert dialog. dismissAlert :: WebDriver wd => wd ()-dismissAlert = noReturn $ doSessCommand POST "/dismiss_alert" Null+dismissAlert = noReturn $ doSessCommand methodPost "/dismiss_alert" Null -- |Moves the mouse to the given position relative to the active element. moveTo :: WebDriver wd => (Int, Int) -> wd ()-moveTo = noReturn . doSessCommand POST "/moveto" . pair ("xoffset","yoffset")+moveTo = noReturn . doSessCommand methodPost "/moveto" . pair ("xoffset","yoffset") -- |Moves the mouse to the center of a given element. moveToCenter :: WebDriver wd => Element -> wd () moveToCenter (Element e) =- noReturn . doSessCommand POST "/moveto" . single "element" $ e+ noReturn . doSessCommand methodPost "/moveto" . single "element" $ e -- |Moves the mouse to the given position relative to the given element. moveToFrom :: WebDriver wd => (Int, Int) -> Element -> wd () moveToFrom (x,y) (Element e) =- noReturn . doSessCommand POST "/moveto"+ noReturn . doSessCommand methodPost "/moveto" . triple ("element","xoffset","yoffset") $ (e,x,y) -- |A mouse button@@ -577,7 +576,7 @@ -- |Click at the current mouse position with the given mouse button. clickWith :: WebDriver wd => MouseButton -> wd ()-clickWith = noReturn . doSessCommand POST "/click" . single "button"+clickWith = noReturn . doSessCommand methodPost "/click" . single "button" -- |Perform the given action with the left mouse button held down. The mouse -- is automatically released afterwards.@@ -587,44 +586,44 @@ -- |Press and hold the left mouse button down. Note that undefined behavior -- occurs if the next mouse command is not mouseUp. mouseDown :: WebDriver wd => wd ()-mouseDown = noReturn $ doSessCommand POST "/buttondown" Null+mouseDown = noReturn $ doSessCommand methodPost "/buttondown" Null -- |Release the left mouse button. mouseUp :: WebDriver wd => wd ()-mouseUp = noReturn $ doSessCommand POST "/buttonup" Null+mouseUp = noReturn $ doSessCommand methodPost "/buttonup" Null -- |Double click at the current mouse location. doubleClick :: WebDriver wd => wd ()-doubleClick = noReturn $ doSessCommand POST "/doubleclick" Null+doubleClick = noReturn $ doSessCommand methodPost "/doubleclick" Null -- |Single tap on the touch screen at the given element's location. touchClick :: WebDriver wd => Element -> wd () touchClick (Element e) =- noReturn . doSessCommand POST "/touch/click" . single "element" $ e+ noReturn . doSessCommand methodPost "/touch/click" . single "element" $ e -- |Emulates pressing a finger down on the screen at the given location. touchDown :: WebDriver wd => (Int, Int) -> wd ()-touchDown = noReturn . doSessCommand POST "/touch/down" . pair ("x","y")+touchDown = noReturn . doSessCommand methodPost "/touch/down" . pair ("x","y") -- |Emulates removing a finger from the screen at the given location. touchUp :: WebDriver wd => (Int, Int) -> wd ()-touchUp = noReturn . doSessCommand POST "/touch/up" . pair ("x","y")+touchUp = noReturn . doSessCommand methodPost "/touch/up" . pair ("x","y") -- |Emulates moving a finger on the screen to the given location. touchMove :: WebDriver wd => (Int, Int) -> wd ()-touchMove = noReturn . doSessCommand POST "/touch/move" . pair ("x","y")+touchMove = noReturn . doSessCommand methodPost "/touch/move" . pair ("x","y") -- |Emulate finger-based touch scroll. Use this function if you don't care where -- the scroll begins touchScroll :: WebDriver wd => (Int, Int) -> wd ()-touchScroll = noReturn . doSessCommand POST "/touch/scroll" . pair ("xoffset","yoffset")+touchScroll = noReturn . doSessCommand methodPost "/touch/scroll" . pair ("xoffset","yoffset") -- |Emulate finger-based touch scroll, starting from the given location relative -- to the given element. touchScrollFrom :: WebDriver wd => (Int, Int) -> Element -> wd () touchScrollFrom (x, y) (Element e) = noReturn- . doSessCommand POST "/touch/scroll"+ . doSessCommand methodPost "/touch/scroll" . triple ("xoffset", "yoffset", "element") $ (x, y, e) @@ -632,14 +631,14 @@ touchDoubleClick :: WebDriver wd => Element -> wd () touchDoubleClick (Element e) = noReturn- . doSessCommand POST "/touch/doubleclick"+ . doSessCommand methodPost "/touch/doubleclick" . single "element" $ e -- |Emulate a long click on a touch device. touchLongClick :: WebDriver wd => Element -> wd () touchLongClick (Element e) = noReturn- . doSessCommand POST "/touch/longclick"+ . doSessCommand methodPost "/touch/longclick" . single "element" $ e -- |Emulate a flick on the touch screen. The coordinates indicate x and y -- velocity, respectively. Use this function if you don't care where the@@ -647,7 +646,7 @@ touchFlick :: WebDriver wd => (Int, Int) -> wd () touchFlick = noReturn- . doSessCommand POST "/touch/flick"+ . doSessCommand methodPost "/touch/flick" . pair ("xSpeed", "ySpeed") -- |Emulate a flick on the touch screen.@@ -658,7 +657,7 @@ -> wd () touchFlickFrom s (x,y) (Element e) = noReturn- . doSessCommand POST "/touch/flick" . object $+ . doSessCommand methodPost "/touch/flick" . object $ ["xoffset" .= x ,"yoffset" .= y ,"speed" .= s@@ -667,12 +666,12 @@ -- |Get the current geographical location of the device. getLocation :: WebDriver wd => wd (Int, Int, Int)-getLocation = doSessCommand GET "/location" Null+getLocation = doSessCommand methodGet "/location" Null >>= parseTriple "latitude" "longitude" "altitude" "getLocation" -- |Set the current geographical location of the device. setLocation :: WebDriver wd => (Int, Int, Int) -> wd ()-setLocation = noReturn . doSessCommand POST "/location"+setLocation = noReturn . doSessCommand methodPost "/location" . triple ("latitude", "longitude", "altitude")@@ -695,21 +694,21 @@ -- This allows you to specify the exact details of -- the zip entry sent across network. uploadZipEntry :: WebDriver wd => Entry -> wd ()-uploadZipEntry = noReturn . doSessCommand POST "/file" . single "file"+uploadZipEntry = noReturn . doSessCommand methodPost "/file" . single "file" . TL.decodeUtf8 . B64.encode . fromArchive . (`addEntryToArchive` emptyArchive) -- |Get the current number of keys in a web storage area. storageSize :: WebDriver wd => WebStorageType -> wd Integer-storageSize s = doStorageCommand GET s "/size" Null+storageSize s = doStorageCommand methodGet s "/size" Null -- |Get a list of all keys from a web storage area. getAllKeys :: WebDriver wd => WebStorageType -> wd [Text]-getAllKeys s = doStorageCommand GET s "" Null+getAllKeys s = doStorageCommand methodGet s "" Null -- |Delete all keys within a given web storage area. deleteAllKeys :: WebDriver wd => WebStorageType -> wd ()-deleteAllKeys s = noReturn $ doStorageCommand DELETE s "" Null+deleteAllKeys s = noReturn $ doStorageCommand methodDelete s "" Null -- |An HTML 5 storage type data WebStorageType = LocalStorage | SessionStorage@@ -719,19 +718,19 @@ -- Unset keys result in empty strings, since the Web Storage spec -- makes no distinction between the empty string and an undefined value. getKey :: WebDriver wd => WebStorageType -> Text -> wd Text-getKey s k = doStorageCommand GET s ("/key/" `T.append` urlEncode k) Null+getKey s k = doStorageCommand methodGet s ("/key/" `T.append` urlEncode k) Null -- |Set a key in the given web storage area. setKey :: WebDriver wd => WebStorageType -> Text -> Text -> wd Text-setKey s k v = doStorageCommand POST s "" . object $ ["key" .= k,+setKey s k v = doStorageCommand methodPost s "" . object $ ["key" .= k, "value" .= v ] -- |Delete a key in the given web storage area. deleteKey :: WebDriver wd => WebStorageType -> Text -> wd ()-deleteKey s k = noReturn $ doStorageCommand POST s ("/key/" `T.append` urlEncode k) Null+deleteKey s k = noReturn $ doStorageCommand methodPost s ("/key/" `T.append` urlEncode k) Null -- |A wrapper around 'doStorageCommand' to create web storage URLs. doStorageCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>- RequestMethod -> WebStorageType -> Text -> a -> wd b+ Method -> WebStorageType -> Text -> a -> wd b doStorageCommand m s path a = doSessCommand m (T.concat ["/", s', path]) a where s' = case s of LocalStorage -> "local_storage"@@ -741,7 +740,7 @@ -- about this object see -- <http://code.google.com/p/selenium/wiki/JsonWireProtocol#/status> serverStatus :: (WebDriver wd) => wd Value -- todo: make this a record type-serverStatus = doCommand GET "/status" Null+serverStatus = doCommand methodGet "/status" Null -- |A record that represents a single log entry. data LogEntry =@@ -768,11 +767,11 @@ -- Which log types are available is server defined, but the wire protocol lists these as common log types: -- client, driver, browser, server getLogs :: WebDriver wd => LogType -> wd [LogEntry]-getLogs t = doSessCommand POST "/log" . object $ ["type" .= t]+getLogs t = doSessCommand methodPost "/log" . object $ ["type" .= t] -- |Get a list of available log types. getLogTypes :: WebDriver wd => wd [LogType]-getLogTypes = doSessCommand GET "/log/types" Null+getLogTypes = doSessCommand methodGet "/log/types" Null data ApplicationCacheStatus = Uncached | Idle | Checking | Downloading | UpdateReady | Obsolete deriving (Eq, Enum, Bounded, Ord, Show, Read) @@ -789,7 +788,7 @@ err -> fail $ "Invalid JSON for ApplicationCacheStatus: " ++ show err getApplicationCacheStatus :: (WebDriver wd) => wd ApplicationCacheStatus-getApplicationCacheStatus = doSessCommand GET "/application_cache/status" Null+getApplicationCacheStatus = doSessCommand methodGet "/application_cache/status" Null -- Moving this closer to the definition of Cookie seems to cause strange compile -- errors, so I'm leaving it here for now.
src/Test/WebDriver/Commands/Internal.hs view
@@ -16,7 +16,8 @@ , NoSessionId(..) ) where -import Test.WebDriver.Classes+import Test.WebDriver.Class+import Test.WebDriver.Session import Test.WebDriver.Utils (urlEncode) import Data.Aeson@@ -64,7 +65,7 @@ -- :sessionId is a URL parameter as described in -- <http://code.google.com/p/selenium/wiki/JsonWireProtocol> doSessCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>- RequestMethod -> Text -> a -> wd b+ Method -> Text -> a -> wd b doSessCommand method path args = do WDSession { wdSessId = mSessId } <- getSession case mSessId of@@ -80,7 +81,7 @@ -- \"/session/:sessionId/element/:id/active\", where :sessionId and :id are URL -- parameters as described in the wire protocol. doElemCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>- RequestMethod -> Element -> Text -> a -> wd b+ Method -> Element -> Text -> a -> wd b doElemCommand m (Element e) path a = doSessCommand m (T.concat ["/element/", urlEncode e, path]) a @@ -89,6 +90,6 @@ -- \"/session/:sessionId/window/:windowHandle/\", where :sessionId and -- :windowHandle are URL parameters as described in the wire protocol doWinCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>- RequestMethod -> WindowHandle -> Text -> a -> wd b+ Method -> WindowHandle -> Text -> a -> wd b doWinCommand m (WindowHandle w) path a = doSessCommand m (T.concat ["/window/", urlEncode w, path]) a
src/Test/WebDriver/Commands/Wait.hs view
@@ -11,15 +11,18 @@ , ifM, (<||>), (<&&>), notM ) where import Test.WebDriver.Exceptions-import Test.WebDriver.Classes+import Test.WebDriver.Session+ import Control.Monad.Base import Control.Monad.Trans.Control import Control.Exception.Lifted import Control.Concurrent+import Control.Conditional (ifM, (<||>), (<&&>), notM)+ import Data.Time.Clock import Data.Typeable-import Control.Conditional (ifM, (<||>), (<&&>), notM) + #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding (catch) #endif@@ -57,29 +60,29 @@ -- 'FailedCommand' 'NoSuchElement' exceptions occur. If the timeout is reached, -- then a 'Timeout' exception will be raised. The timeout value -- is expressed in seconds.-waitUntil :: SessionState m => Double -> m a -> m a+waitUntil :: (WDSessionState m) => Double -> m a -> m a waitUntil = waitUntil' 500000 -- |Similar to 'waitUntil' but allows you to also specify the poll frequency -- of the 'WD' action. The frequency is expressed as an integer in microseconds.-waitUntil' :: SessionState m => Int -> Double -> m a -> m a+waitUntil' :: (WDSessionState m) => Int -> Double -> m a -> m a waitUntil' = waitEither id (\_ -> return) -- |Like 'waitUntil', but retries the action until it fails or until the timeout -- is exceeded.-waitWhile :: SessionState m => Double -> m a -> m ()+waitWhile :: (WDSessionState m) => Double -> m a -> m () waitWhile = waitWhile' 500000 -- |Like 'waitUntil'', but retries the action until it either fails or -- until the timeout is exceeded.-waitWhile' :: SessionState m => Int -> Double -> m a -> m ()+waitWhile' :: (WDSessionState m) => Int -> Double -> m a -> m () waitWhile' = waitEither (\_ _ -> return ()) (\retry _ -> retry "waitWhile: action did not fail") -- |Internal function used to implement explicit wait commands using success and failure continuations-waitEither :: SessionState m =>+waitEither :: (WDSessionState m) => ((String -> m b) -> String -> m b) -> ((String -> m b) -> a -> m b) -> Int -> Double -> m a -> m b@@ -96,7 +99,7 @@ handleExpectFailed (e :: ExpectFailed) = return . Left . show $ e -wait' :: SessionState m =>+wait' :: (WDSessionState m) => ((String -> m b) -> m a -> m b) -> Int -> Double -> m a -> m b wait' handler waitAmnt t wd = waitLoop =<< liftBase getCurrentTime where
+ src/Test/WebDriver/Config.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleContexts #-}+module Test.WebDriver.Config(+ -- * WebDriver configuration+ WDConfig(..), defaultConfig, mkSession + ) where+import Test.WebDriver.Session+import Test.WebDriver.Capabilities++import Data.Default (Default, def)+import Data.String (fromString)++import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) ++import Control.Monad.Base (MonadBase, liftBase)++-- |WebDriver session configuration+data WDConfig = WDConfig {+ -- |Host name of the WebDriver server for this+ -- session (default 127.0.0.1)+ wdHost :: String+ -- |Port number of the server (default 4444)+ , wdPort :: Int+ -- |Capabilities to use for this session+ , wdCapabilities :: Capabilities+ -- |Whether or not we should keep a history of HTTP requests/responses+ --+ -- By default, only the last request/response pair is stored (O(1) heap consumption).+ -- Enable this option for more detailed debugging info for HTTP requests.+ , wdKeepSessHist :: Bool+ -- |Base path for all API requests (default "/wd/hub")+ , wdBasePath :: String+ -- |Use the given http-client 'Manager' instead of the default+ , wdHTTPManager :: Maybe Manager++}++instance Default WDConfig where+ def = WDConfig {+ wdHost = "127.0.0.1"+ , wdPort = 4444+ , wdCapabilities = def+ , wdKeepSessHist = False + , wdBasePath = "/wd/hub"+ , wdHTTPManager = Nothing+ }+ +{- |A default session config connects to localhost on port 4444, and hasn't been+initialized server-side. This value is the same as 'def' but with a less+polymorphic type. -}+defaultConfig :: WDConfig+defaultConfig = def+ +-- |Constructs a new 'WDSession' from a given 'WDConfig'+mkSession :: MonadBase IO m => WDConfig -> m WDSession+mkSession WDConfig{..} = do+ manager <- maybe createManager return wdHTTPManager+ return WDSession { wdSessHost = fromString $ wdHost+ , wdSessPort = wdPort+ , wdSessBasePath = fromString $ wdBasePath+ , wdSessId = Nothing+ , wdSessHist = []+ , wdSessHistUpdate = histUpdate+ , wdSessHTTPManager = manager }+ where+ createManager = liftBase $ newManager defaultManagerSettings+ histUpdate+ | wdKeepSessHist = (:)+ | otherwise = \x _ -> [x]+ +++ ++
src/Test/WebDriver/Internal.hs view
@@ -1,7 +1,12 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts, OverloadedStrings, DeriveDataTypeable,+ RecordWildCards, ScopedTypeVariables #-}+-- |The HTTP/JSON plumbing used to implement the 'WD' monad.+--+-- These functions can be used to create your own 'WebDriver' instances, providing extra functionality for your application if desired. All exports+-- of this module are subject to change at any point. module Test.WebDriver.Internal- ( mkWDUri, mkRequest, sendHTTPRequest- , handleHTTPErr, handleJSONErr, handleHTTPResp+ ( mkRequest, sendHTTPRequest+ , getJSONResult, handleJSONErr, handleRespSessionId , WDResponse(..) , InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..)@@ -10,145 +15,140 @@ , FailedCommand(..), failedCommand, mkFailedCommandInfo , FailedCommandType(..), FailedCommandInfo(..), StackFrame(..) ) where-import Test.WebDriver.Classes+import Test.WebDriver.Class import Test.WebDriver.JSON+import Test.WebDriver.Session -import Network.HTTP (simpleHTTP, Request(..), Response(..))-import Network.HTTP.Headers (findHeader, Header(..), HeaderName(..))-import Network.Stream (ConnError)-import Network.URI+import Network.HTTP.Client (httpLbs, Request(..), RequestBody(..), Response(..))+import Network.HTTP.Types.Header+import Network.HTTP.Types.Status (Status(..)) import Data.Aeson import Data.Aeson.Types (Parser, typeMismatch) -import Data.Text as T (Text, unpack, splitOn, null)+import Data.Text as T (Text, splitOn, null)+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy.Encoding as TLE import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 as LBS (length, unpack, null)+import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Base64.Lazy as B64-import qualified Data.Text.Lazy.Encoding as TL + import Control.Monad.Base import Control.Exception.Lifted (throwIO) import Control.Applicative+import Control.Exception (SomeException, toException) import Control.Exception (Exception) import Data.Typeable (Typeable)-import Data.List (isInfixOf) import Data.Maybe (fromMaybe) import Data.String (fromString) import Data.Word (Word, Word8)---- |Take a URL path and construct a full URL using the current session state-mkWDUri :: (SessionState s) => String -> s URI-mkWDUri wdPath = do- WDSession{wdHost = host,- wdPort = port,- wdBasePath = basePath- } <- getSession- let urlStr = "http://" ++ host ++ ":" ++ show port- relPath = basePath ++ wdPath- mBaseURI = parseAbsoluteURI urlStr- mRelURI = parseRelativeReference relPath- case (mBaseURI, mRelURI) of- (Nothing, _) -> throwIO $ InvalidURL urlStr- (_, Nothing) -> throwIO $ InvalidURL relPath- (Just baseURI, Just relURI) -> return $ relURI `relativeTo` baseURI+import Data.Default --- |Constructs a 'Request' value when given a list of headers, HTTP request method, and URL path-mkRequest :: (SessionState s, ToJSON a) =>- [Header] -> RequestMethod -> Text -> a -> s (Request ByteString)-mkRequest headers method wdPath args = do- uri <- mkWDUri (T.unpack wdPath)+-- |Constructs an HTTP 'Request' value when given a list of headers, HTTP request method, and URL fragment+mkRequest :: (WDSessionState s, ToJSON a) =>+ RequestHeaders -> Method -> Text -> a -> s Request+mkRequest headers meth wdPath args = do+ WDSession {..} <- getSession let body = case toJSON args of Null -> "" --passing Null as the argument indicates no request body other -> encode other- return Request { rqURI = uri --todo: normalization of headers- , rqMethod = method- , rqBody = body- , rqHeaders = headers ++ [ Header HdrAccept- "application/json;charset=UTF-8"- , Header HdrContentType- "application/json;charset=UTF-8"- , Header HdrContentLength- . show . LBS.length $ body- ]- }--+ return def { host = wdSessHost+ , port = wdSessPort+ , path = wdSessBasePath `BS.append` TE.encodeUtf8 wdPath+ , requestBody = RequestBodyLBS body+ , requestHeaders = headers ++ [ (hAccept, "application/json;charset=UTF-8")+ , (hContentType, "application/json;charset=UTF-8")+ , (hContentLength, fromString . show . LBS.length $ body) ]+ , method = meth } -sendHTTPRequest :: SessionState s => Request ByteString -> s (Response ByteString)+-- |Sends an HTTP request to the remote WebDriver server+sendHTTPRequest :: (WDSessionState s) => Request -> s (Response ByteString) sendHTTPRequest req = do- res <- liftBase (simpleHTTP req) >>= either (throwIO . HTTPConnError) return- modifySession $ \s -> s {wdSessHist = (req, res) : if wdKeepSessHist s then wdSessHist s else []} -- update httpScript field+ s@WDSession{..} <- getSession+ res <- liftBase $ httpLbs req wdSessHTTPManager+ putSession s {wdSessHist = wdSessHistUpdate (req, res) wdSessHist} return res--handleHTTPErr :: SessionState s => Response ByteString -> s ()-handleHTTPErr r@Response{rspBody = body, rspCode = code, rspReason = reason} =- case code of- (4,_,_) -> do- lastReq <- lastHTTPRequest <$> getSession- throwIO . UnknownCommand . maybe reason show- $ lastReq- (5,_,_) ->- case findHeader HdrContentType r of- Just ct- | "application/json;" `isInfixOf` ct -> parseJSON' body- >>= handleJSONErr- | otherwise -> err ServerError- Nothing ->- err (ServerError . ("Missing content type. Server response: "++))-- (2,_,_) -> return ()- (3,0,x) | x `elem` [2,3]- -> return ()- _ -> err (HTTPStatusUnknown code)- where- err errType = throwIO $ errType reason--handleHTTPResp :: (SessionState s, FromJSON a) => Response ByteString -> s a-handleHTTPResp resp@Response{rspBody = body, rspCode = code} =- case code of- (2,0,4) -> noReturn- (3,0,x)- | x `elem` [2,3] ->- case findHeader HdrLocation resp of- Nothing -> throwIO . HTTPStatusUnknown code- $ (LBS.unpack body)- Just loc -> do- let sessId = last . filter (not . T.null) . splitOn "/" . fromString $ loc- modifySession $ \sess -> sess {wdSessId = Just (SessionId sessId)}- fromJSON' . String $ sessId- _- | LBS.null body -> noReturn- | otherwise -> do- sess@WDSession { wdSessId = sessId} <- getSession -- get current session state- WDResponse { rspSessId = sessId'- , rspVal = val} <- parseJSON' body -- parse response body- case (sessId, (==) <$> sessId <*> sessId') of- -- if our monad has an uninitialized session ID, initialize it from the response object- (Nothing, _) -> putSession sess { wdSessId = sessId' }- -- if the response ID doesn't match our local ID, throw an error.- (_, Just False) -> throwIO . ServerError $ "Server response session ID (" ++ show sessId'- ++ ") does not match local session ID (" ++ show sessId ++ ")"- -- otherwise nothing needs to be done- _ -> return ()- fromJSON' val-+ + +-- |Parses a 'WDResponse' object from a given HTTP response.+getJSONResult :: (WDSessionState s, FromJSON a) => Response ByteString -> s (Either SomeException a)+getJSONResult r+ --malformed request errors+ | code >= 400 && code < 500 = do+ lastReq <- lastHTTPRequest <$> getSession+ returnErr . UnknownCommand . maybe reason show $ lastReq+ --server-side errors+ | code >= 500 && code < 600 = + case lookup hContentType headers of+ Just ct+ | "application/json;" `BS.isInfixOf` ct ->+ parseJSON' body+ >>= handleJSONErr+ >>= maybe noReturn returnErr+ | otherwise -> + returnHTTPErr ServerError+ Nothing ->+ returnHTTPErr (ServerError . ("HTTP response missing content type. Server reason was: "++))+ --redirect case (used as a response to createSession requests) + | code == 302 || code == 303 =+ case lookup hLocation headers of+ Nothing -> returnErr . HTTPStatusUnknown code $ LBS.unpack body+ Just loc -> do+ let sessId = last . filter (not . T.null) . splitOn "/" . fromString $ BS.unpack loc+ modifySession $ \sess -> sess {wdSessId = Just (SessionId sessId)}+ noReturn+ -- No Content response+ | code == 204 = noReturn+ -- HTTP Success+ | code >= 200 && code < 300 = + if LBS.null body+ then noReturn+ else do+ rsp@WDResponse {rspVal = val} <- parseJSON' body + handleJSONErr rsp >>= maybe + (handleRespSessionId rsp >> Right <$> fromJSON' val)+ returnErr + -- other status codes: return error+ | otherwise = returnHTTPErr (HTTPStatusUnknown code) where- noReturn = fromJSON' Null+ --helper functions+ returnErr :: (Exception e, Monad m) => e -> m (Either SomeException a)+ returnErr = return . Left . toException+ returnHTTPErr errType = returnErr . errType $ reason+ noReturn = Right <$> fromJSON' Null+ --HTTP response variables+ code = statusCode status+ reason = BS.unpack $ statusMessage status+ status = responseStatus r + body = responseBody r + headers = responseHeaders r -handleJSONErr :: SessionState s => WDResponse -> s ()-handleJSONErr WDResponse{rspStatus = 0} = return ()+handleRespSessionId :: (WDSessionState s) => WDResponse -> s ()+handleRespSessionId WDResponse{rspSessId = sessId'} = do+ sess@WDSession { wdSessId = sessId} <- getSession+ case (sessId, (==) <$> sessId <*> sessId') of+ -- if our monad has an uninitialized session ID, initialize it from the response object+ (Nothing, _) -> putSession sess { wdSessId = sessId' }+ -- if the response ID doesn't match our local ID, throw an error.+ (_, Just False) -> throwIO . ServerError $ "Server response session ID (" ++ show sessId'+ ++ ") does not match local session ID (" ++ show sessId ++ ")"+ _ -> return ()+ +handleJSONErr :: (WDSessionState s) => WDResponse -> s (Maybe SomeException)+handleJSONErr WDResponse{rspStatus = 0} = return Nothing handleJSONErr WDResponse{rspVal = val, rspStatus = status} = do sess <- getSession errInfo <- fromJSON' val let screen = B64.decodeLenient <$> errScreen errInfo- errInfo' = errInfo { errSess = sess+ errInfo' = errInfo { errSess = Just sess , errScreen = screen }- e errType = throwIO $ FailedCommand errType errInfo'- case status of+ e errType = toException $ FailedCommand errType errInfo'+ return . Just $ case status of 7 -> e NoSuchElement 8 -> e NoSuchFrame- 9 -> throwIO . UnknownCommand . errMsg $ errInfo+ 9 -> toException . UnknownCommand . errMsg $ errInfo 10 -> e StaleElementReference 11 -> e ElementNotVisible 12 -> e InvalidElementState@@ -176,7 +176,8 @@ -- |Internal type representing the JSON response object-data WDResponse = WDResponse { rspSessId :: Maybe SessionId+data WDResponse = WDResponse { + rspSessId :: Maybe SessionId , rspStatus :: Word8 , rspVal :: Value }@@ -196,13 +197,13 @@ instance Exception HTTPStatusUnknown -- |An unexpected HTTP status was sent by the server.-data HTTPStatusUnknown = HTTPStatusUnknown (Int, Int, Int) String+data HTTPStatusUnknown = HTTPStatusUnknown Int String deriving (Eq, Show, Typeable) instance Exception HTTPConnError -- |HTTP connection errors.-newtype HTTPConnError = HTTPConnError ConnError- deriving (Eq, Show, Typeable)+data HTTPConnError = HTTPConnError String Int+ deriving (Eq, Show, Typeable) instance Exception UnknownCommand -- |A command was sent to the WebDriver server that it didn't recognize.@@ -255,7 +256,7 @@ errMsg :: String -- |The session associated with -- the exception.- , errSess :: WDSession+ , errSess :: Maybe WDSession -- |A screen shot of the focused window -- when the exception occured, -- if provided.@@ -280,25 +281,27 @@ where className = fromMaybe "<unknown exception>" . errClass $ i - sess = showString sessId . showString " at "- . showString host . showChar ':' . shows port- where- sessId = case msid of- Just (SessionId sid) -> T.unpack sid- Nothing -> "<no session id>"- WDSession {wdHost = host, wdPort = port, wdSessId = msid } = errSess i+ sess = case errSess i of+ Nothing -> showString "None"+ Just WDSession{..} ->+ let sessId = maybe "<no session id>" show wdSessId+ in showString sessId . showString " at "+ . shows wdSessHost . showChar ':' . shows wdSessPort -- |Constructs a FailedCommandInfo from only an error message.-mkFailedCommandInfo :: SessionState s => String -> s FailedCommandInfo+mkFailedCommandInfo :: (WDSessionState s) => String -> s FailedCommandInfo mkFailedCommandInfo m = do sess <- getSession- return $ FailedCommandInfo {errMsg = m , errSess = sess , errScreen = Nothing- , errClass = Nothing , errStack = [] }+ return $ FailedCommandInfo { errMsg = m + , errSess = Just sess+ , errScreen = Nothing+ , errClass = Nothing+ , errStack = [] } -- |Convenience function to throw a 'FailedCommand' locally with no server-side -- info present.-failedCommand :: SessionState s => FailedCommandType -> String -> s a+failedCommand :: (WDSessionState s) => FailedCommandType -> String -> s a failedCommand t m = throwIO . FailedCommand t =<< mkFailedCommandInfo m -- |An individual stack frame from the stack trace provided by the server@@ -322,8 +325,8 @@ instance FromJSON FailedCommandInfo where parseJSON (Object o) = FailedCommandInfo <$> (req "message" >>= maybe (return "") return)- <*> pure undefined- <*> (fmap TL.encodeUtf8 <$> opt "screen" Nothing)+ <*> pure Nothing+ <*> (fmap TLE.encodeUtf8 <$> opt "screen" Nothing) <*> opt "class" Nothing <*> opt "stackTrace" [] where req :: FromJSON a => Text -> Parser a
src/Test/WebDriver/Monad.hs view
@@ -2,24 +2,24 @@ MultiParamTypeClasses #-} module Test.WebDriver.Monad ( WD(..), runWD, runSession, withSession, finallyClose, closeOnException, dumpSessionHistory- )where+ ) where -import Test.WebDriver.Classes+import Test.WebDriver.Class+import Test.WebDriver.Session+import Test.WebDriver.Config import Test.WebDriver.Commands-import Test.WebDriver.Capabilities import Test.WebDriver.Internal import Control.Monad.Base (MonadBase, liftBase)-import Control.Monad (liftM)-import Control.Monad.IO.Class-import Control.Monad.Trans (lift)+import Control.Monad.Reader import Control.Monad.Trans.Control (MonadBaseControl(..), StM) import Control.Monad.State.Strict (StateT, MonadState, evalStateT, get, put)-import Control.Monad.IO.Class (MonadIO)+--import Control.Monad.IO.Class (MonadIO) import Control.Exception.Lifted import Control.Monad.Catch (MonadThrow, MonadCatch) import Control.Applicative + {- |A monadic interface to the WebDriver server. This monad is simply a state monad transformer over 'IO', threading session information between sequential webdriver commands -}@@ -38,26 +38,30 @@ restoreM = WD . restoreM . unStWD -instance SessionState WD where+instance WDSessionState WD where getSession = WD get putSession = WD . put instance WebDriver WD where- doCommand method path args = do- req <- mkRequest [] method path args- res <- sendHTTPRequest req- handleHTTPErr res- handleHTTPResp res+ doCommand method path args =+ mkRequest [] method path args+ >>= sendHTTPRequest+ >>= getJSONResult+ >>= either throwIO return + -- |Executes a 'WD' computation within the 'IO' monad, using the given -- 'WDSession'. runWD :: WDSession -> WD a -> IO a runWD sess (WD wd) = evalStateT wd sess --- |Like 'runWD', but automatically creates a session beforehand and closes it--- afterwards. This is a very common use case.-runSession :: WDSession -> Capabilities -> WD a -> IO a-runSession s caps wd = runWD s $ createSession caps >> wd <* closeSession+-- |Executes a 'WD' computation within the 'IO' monad, automatically creating a new session beforehand.+--+-- NOTE: session is not automatically closed. If you want this behavior, use 'finallyClose'.+runSession :: WDConfig -> WD a -> IO a+runSession conf wd = do+ sess <- mkSession conf+ runWD sess $ createSession (wdCapabilities conf) >> wd -- |Locally sets a 'WDSession' for use within the given 'WD' action. -- The state of the outer action is unaffected by this function.@@ -70,17 +74,13 @@ finallyClose:: WebDriver wd => wd a -> wd a finallyClose wd = closeOnException wd <* closeSession --- |A variant of 'finallyClose' that only closes the session when an+-- |Exception handler that closes the session when an -- asynchronous exception is thrown, but otherwise leaves the session open -- if the action was successful. closeOnException :: WebDriver wd => wd a -> wd a closeOnException wd = wd `onException` closeSession --- |Can be called before 'closeOnException' to get more information on--- stdout. about what was going wrong. (Note that the 'Show'--- instances in package HTTP are not very generous with the 'Response'--- and 'Request' type. You might want to write your own variant of--- this function.)+-- |Prints a history of API requests to stdout after computing the given action. dumpSessionHistory :: (MonadIO wd, WebDriver wd) => wd a -> wd a dumpSessionHistory wd = do v <- wd
+ src/Test/WebDriver/Session.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts,+ GeneralizedNewtypeDeriving, RecordWildCards #-}+module Test.WebDriver.Session(+ -- * WDSessionState class+ WDSessionState(..), modifySession+ -- ** WebDriver sessions+ , WDSession(..), lastHTTPRequest, SessionId(..)+ ) where++import Data.Aeson+import Data.ByteString as BS(ByteString) +import Data.ByteString.Lazy as LBS(ByteString)+import Data.Text (Text)+import Data.Maybe++import Control.Monad.Trans.Control+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Identity+import Control.Monad.List+import Control.Monad.Reader+import Control.Monad.Error+--import Control.Monad.Cont+import Control.Monad.Writer.Strict as SW+import Control.Monad.Writer.Lazy as LW+import Control.Monad.State.Strict as SS+import Control.Monad.State.Lazy as LS+import Control.Monad.RWS.Strict as SRWS+import Control.Monad.RWS.Lazy as LRWS++import Network.HTTP.Client (Manager, Request, Response)++{- |An opaque identifier for a WebDriver session. These handles are produced by+the server on session creation, and act to identify a session in progress. -}+newtype SessionId = SessionId Text+ deriving (Eq, Ord, Show, Read, FromJSON, ToJSON)++{- |The local state of a WebDriver session. This structure is passed+implicitly through all 'WD' computations -}+data WDSession = WDSession {+ -- server hostname+ wdSessHost :: BS.ByteString+ -- server port+ , wdSessPort :: Int+ -- Base path for API requests+ , wdSessBasePath :: BS.ByteString+ -- |An opaque reference identifying the session to+ -- use with 'WD' commands.+ -- A value of Nothing indicates that a session+ -- hasn't been created yet.+ -- Sessions can be created within 'WD' via+ -- 'Test.WebDriver.createSession', or created+ -- automatically with 'Test.WebDriver.runSession'+ , wdSessId :: Maybe SessionId+ -- |The complete history of HTTP requests and+ -- responses, most recent first.+ , wdSessHist :: [(Request, Response LBS.ByteString)]+ -- Update function used to append new entries to session history+ , wdSessHistUpdate :: (Request, Response LBS.ByteString)+ -> [(Request, Response LBS.ByteString)]+ -> [(Request, Response LBS.ByteString)]+ -- |HTTP 'Manager' used for connection pooling by the http-client library.+ , wdSessHTTPManager :: Manager+ }+ + -- |The last HTTP request issued by this session, if any.+lastHTTPRequest :: WDSession -> Maybe Request+lastHTTPRequest = fmap fst . listToMaybe . wdSessHist+++-- |A class for monads that carry a WebDriver session with them. The+-- MonadBaseControl superclass is used for exception handling through+-- the lifted-base package.+class MonadBaseControl IO s => WDSessionState s where+ getSession :: s WDSession+ putSession :: WDSession -> s ()++modifySession :: WDSessionState s => (WDSession -> WDSession) -> s ()+modifySession f = getSession >>= putSession . f+ +instance WDSessionState m => WDSessionState (LS.StateT s m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance WDSessionState m => WDSessionState (SS.StateT s m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance WDSessionState m => WDSessionState (MaybeT m) where+ getSession = lift getSession+ putSession = lift . putSession++instance WDSessionState m => WDSessionState (IdentityT m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Monoid w, WDSessionState m) => WDSessionState (LW.WriterT w m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance WDSessionState m => WDSessionState (ReaderT r m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Error e, WDSessionState m) => WDSessionState (ErrorT e m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Monoid w, WDSessionState m) => WDSessionState (SRWS.RWST r w s m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Monoid w, WDSessionState wd) => WDSessionState (LRWS.RWST r w s wd) where+ getSession = lift getSession+ putSession = lift . putSession+
src/Test/WebDriver/Types.hs view
@@ -1,11 +1,13 @@ {-# OPTIONS_HADDOCK not-home #-} module Test.WebDriver.Types ( -- * WebDriver sessions- WD(..), WDSession(..), defaultSession, SessionId(..)- -- * Capabilities and configuration+ WD(..), WDSession(..), SessionId(..)+ -- * WebDriver configuration+ , WDConfig(..), defaultConfig+ -- * Capabilities , Capabilities(..), defaultCaps, allCaps , Platform(..), ProxyType(..), UnexpectedAlertBehavior(..)- -- ** Browser-specific configuration+ -- ** Browser-specific capabilities , Browser(..), -- ** Default settings for browsers firefox, chrome, ie, opera, iPhone, iPad, android@@ -32,7 +34,8 @@ ) where import Test.WebDriver.Monad-import Test.WebDriver.Classes+import Test.WebDriver.Session+import Test.WebDriver.Config import Test.WebDriver.Commands import Test.WebDriver.Exceptions import Test.WebDriver.Capabilities
src/Test/WebDriver/Utils.hs view
@@ -1,8 +1,8 @@ module Test.WebDriver.Utils where import Data.Text (Text)-import qualified Data.Text as T-import qualified Network.HTTP.Base as HTTP+import Data.Text.Encoding as TE+import qualified Network.HTTP.Types.URI as HTTP urlEncode :: Text -> Text-urlEncode = T.pack . HTTP.urlEncode . T.unpack+urlEncode = TE.decodeUtf8 . HTTP.urlEncode False . TE.encodeUtf8
test/search-baidu.hs view
@@ -3,11 +3,11 @@ import Control.Concurrent import Control.Parallel-import Control.Monad (void)+import Control.Monad (void) import Data.List import qualified Data.Text as T import Test.WebDriver-import Test.WebDriver.Classes+--import Test.WebDriver.Classes import Test.WebDriver.Commands.Wait capsChrome = defaultCaps { browser = chrome }@@ -28,7 +28,7 @@ title <- getTitle return ("cheese!" `T.isSuffixOf` title) -testCase c = void $ runSession defaultSession c (baidu >> searchBaidu)+testCase c = void $ runSession defaultConfig c (baidu >> searchBaidu) testSuits = mapM_ testCase [capsFF, capsChrome]
webdriver.cabal view
@@ -1,5 +1,5 @@ Name: webdriver-Version: 0.5.5+Version: 0.6 Cabal-Version: >= 1.8 License: BSD3 License-File: LICENSE@@ -31,33 +31,36 @@ ghc-options: -Wall build-depends: base == 4.* , aeson >= 0.6.2.0 && < 0.8- , HTTP >= 4000.1 && < 4000.3- , mtl >= 2.0 && < 2.3 , network >= 2.4 && < 2.6- , bytestring >= 0.9 && < 0.11+ , http-client >= 0.3 && < 0.4+ , http-types >= 0.8 && < 0.9 , text >= 0.11.3 && < 1.2.0.0- , time == 1.*+ , bytestring >= 0.9 && < 0.11+ , attoparsec < 0.12+ , base64-bytestring >= 1.0 && < 1.1+ , mtl >= 2.0 && < 2.3 , transformers >= 0.2 && < 0.5+ , monad-control == 0.3.* + , transformers-base >= 0.1 && < 1.0+ , lifted-base >= 0.1 && < 0.3 , zip-archive >= 0.1.1.8 && < 0.3 , directory == 1.* , filepath == 1.*+ , directory-tree == 0.11.*+ , temporary >= 1.0 && < 2.0+ , time == 1.* , unordered-containers >= 0.1.3 && < 0.4- , attoparsec < 0.12- , monad-control == 0.3.*- , transformers-base >= 0.1 && < 1.0 , vector >= 0.3 && < 0.11- , lifted-base >= 0.1 && < 0.3 , exceptions >= 0.4 && < 0.6- , directory-tree == 0.11.*+ , scientific >= 0.2 && < 0.4 , data-default >= 0.2 && < 1.0- , temporary >= 1.0 && < 2.0- , base64-bytestring >= 1.0 && < 1.1 , cond >= 0.3 && < 0.5- , scientific >= 0.2 && < 0.4 exposed-modules: Test.WebDriver- Test.WebDriver.Classes+ Test.WebDriver.Class Test.WebDriver.Monad+ Test.WebDriver.Session+ Test.WebDriver.Config Test.WebDriver.Exceptions Test.WebDriver.Commands Test.WebDriver.Commands.Wait