module Selenium.Server (
Browser(..),
SCommand(..),
SeleniumRCSession(..),
Selenium,
mkSeleniumRCSession,
startSelenium,
stopSelenium,
withSelenium,
runSelenium,
runSeleniumReader,
doCommand,
doCommandList,
mkURI,
open,
click,
clickAndWait,
check,
uncheck,
typeText,
isTextPresent,
isElementPresent,
isChecked,
waitForPage,
waitForCondition,
keyPress,
submit,
selectFrame,
mouseDown,
mouseMove,
mouseUp,
dragAndDrop,
dragAndDropToObject,
getAttribute,
getBodyText,
getAllLinks,
evalJS
) where
import Control.Monad.Error
import Control.Monad.Reader
import Data.Either
import Data.Maybe
import Network.BSD
import Network.HTTP
import Network.URI
import Selenium.Pretty
import Selenium.Syntax
data SeleniumRCSession =
SeleniumRCSession {
selHost :: HostName,
selPort :: Int,
selBrowser :: Browser,
selURL :: URI,
selSessionID :: Maybe Integer
}
data Browser = InternetExplorer | Firefox | Konqueror | Opera | Safari
instance Show Browser where
show InternetExplorer = "*iexplore"
show Firefox = "*firefox"
show Konqueror = "*konqueror"
show Opera = "*opera"
show Safari = "*safari"
newtype Selenium a = Selenium (ReaderT SeleniumRCSession (ErrorT String IO) a)
deriving (Functor, Monad, MonadIO, MonadReader SeleniumRCSession, MonadError String)
runSeleniumReader :: SeleniumRCSession -> Selenium a -> ErrorT String IO a
runSeleniumReader sel (Selenium body) = runReaderT body sel
runSelenium :: SeleniumRCSession -> Selenium a -> IO (Either String a)
runSelenium sel (Selenium body) = runErrorT $ runReaderT body sel
mkSeleniumRCSession :: HostName -> Browser -> URI -> SeleniumRCSession
mkSeleniumRCSession seleniumHostName browserType url =
SeleniumRCSession { selHost = seleniumHostName
, selPort = 4444
, selBrowser = browserType
, selURL = url
, selSessionID = Nothing }
withSelenium :: SeleniumRCSession
-> Selenium a
-> IO (Either String a)
withSelenium sel body = runErrorT $ do
newSel <- runSeleniumReader sel startSelenium
runSeleniumReader newSel $ do r <- body; stopSelenium; return r
startSelenium :: Selenium SeleniumRCSession
startSelenium = do
sel <- ask
session <- integerCommand SNewSession [ show (selBrowser sel)
, show (selURL sel) ]
return $ sel { selSessionID = Just session }
stopSelenium :: Selenium ()
stopSelenium = do
doCommand STestComplete []
return ()
doCommand :: SCommand -> [String] -> Selenium String
doCommand cmd args = do
sel <- ask
let uri = mkURI sel cmd args
when (isNothing uri) (throwError "created bad URI")
result <- liftIO $ simpleHTTP (Request { rqURI = fromJust uri
, rqMethod = GET
, rqHeaders = []
, rqBody = "" })
let textResult = either
(\_ -> "ERROR: HTTP Request failed")
(\r -> rspBody r) result
when (take 5 textResult == "ERROR") (throwError textResult)
return $ stringResult textResult
doCommandList :: [(SCommand, [String])] -> Selenium [String]
doCommandList = mapM (uncurry doCommand)
mkURI :: SeleniumRCSession -> SCommand -> [String] -> Maybe URI
mkURI sel cmd args =
parseURI $ "http://" ++ selHost sel <:> show (selPort sel)
++ "/selenium-server/driver/?cmd" <=> rest
where rest = escape (show cmd) ++
concatMap toField (zip indices (map escape args)) ++
sessionId
indices = iterate (+1) (1::Integer)
toField (key, val) = "&" ++ show key <=> val
sessionId =
maybe "" (\p -> "&sessionId" <=> (show p)) (selSessionID sel)
escape s = escapeURIString isUnreserved s
stringResult :: String -> String
stringResult s = case s of
'O':'K':',':ts -> ts
'F':'A':'I':'L':',':ts -> ts
ts -> ts
integerResult :: String -> Integer
integerResult = read . stringResult
boolResult :: String -> Bool
boolResult str = stringResult str == "true"
stringListResult :: String -> [String]
stringListResult str = reverse $ parseCSVLine [] "" str
where parseCSVLine :: [String] -> String -> String -> [String]
parseCSVLine fields field [] = (reverse field):fields
parseCSVLine fields field ('\\':c:rest) =
parseCSVLine fields (c:field) rest
parseCSVLine fields field (',':rest) =
parseCSVLine ((reverse field):fields) "" rest
parseCSVLine fields field (c:rest) =
parseCSVLine fields (c:field) rest
liftCommand :: (String -> a) -> SCommand -> [String] -> Selenium a
liftCommand f cmd args = (liftM f) $ doCommand cmd args
integerCommand :: SCommand -> [String] -> Selenium Integer
integerCommand = liftCommand integerResult
boolCommand :: SCommand -> [String] -> Selenium Bool
boolCommand = liftCommand boolResult
stringListCommand :: SCommand -> [String] -> Selenium [String]
stringListCommand = liftCommand stringListResult
open :: String -> Selenium String
open url = doCommand SOpen [url]
submit :: Locator -> Selenium String
submit locator = doCommand SSubmit [show locator]
selectFrame :: String -> Selenium String
selectFrame name = doCommand SSelectFrame [name]
check, uncheck, click :: Locator -> Selenium String
check locator = doCommand SCheck [show locator]
uncheck locator = doCommand SUncheck [show locator]
click locator = doCommand SClick [show locator]
clickAndWait :: Locator -> Selenium String
clickAndWait locator = do click locator; waitForPage 30000
isTextPresent :: String -> Selenium Bool
isTextPresent txt = boolCommand SIsTextPresent [txt]
isElementPresent :: Locator -> Selenium Bool
isElementPresent locator = boolCommand SIsElementPresent [show locator]
isChecked :: Locator -> Selenium Bool
isChecked locator = boolCommand SIsChecked [show locator]
typeText, keyPress :: Locator -> String -> Selenium String
typeText locator txt = doCommand SType [show locator, txt]
keyPress locator key = doCommand SKeyPress [show locator, key]
waitForPage :: Integer -> Selenium String
waitForPage timeout = doCommand SWaitForPage [show timeout]
mouseDown, mouseMove, mouseUp :: Locator -> Selenium String
mouseDown loc = doCommand SMouseDown [show loc]
mouseMove loc = doCommand SMouseMove [show loc]
mouseUp loc = doCommand SMouseUp [show loc]
dragAndDrop :: Locator -> String -> Selenium String
dragAndDrop loc movement = doCommand SDragAndDrop [show loc, movement]
dragAndDropToObject :: Locator -> Locator -> Selenium String
dragAndDropToObject src dst = doCommand SDragAndDropToObject [show src
, show dst]
getAttribute :: Locator -> Selenium String
getAttribute locator = doCommand SGetAttribute [show locator]
getBodyText :: Selenium String
getBodyText = doCommand SGetBodyText []
evalJS :: String -> Selenium String
evalJS script = doCommand SEval [script]
waitForCondition :: String -> Integer -> Selenium String
waitForCondition cond timeout = doCommand SWaitForCondition [cond, show timeout]
getAllLinks :: Selenium [String]
getAllLinks = stringListCommand SGetAllLinks []