{-# LANGUAGE CPP #-}
--------------------------------------------------------------------
-- |
-- Module    : Test.Selenium.Server
-- Copyright : (c) Galois, Inc. 2007
-- License   : BSD3
--
-- Maintainer: Aaron Tomb <atomb@galois.com>
-- Stability : provisional
-- Portability:  Uses mtl, Generalised Newtype Deriving, CPP
--
-- A Haskell binding the HTTP protocol spoken by the Selenium Remote Control
-- server. The Selenium server allows remote clients to control a web browser,
-- acting as automated users.
--
--------------------------------------------------------------------

module Test.Selenium.Server (

    -- * Types
    Browser(..),
    SCommand(..),
    SeleniumRCSession(..),
    Selenium,

    -- * Basic functions
    mkSeleniumRCSession,
    startSelenium,
    stopSelenium,
    withSelenium,
    runSelenium,
    runSeleniumReader,
    doCommand,
    doCommandList,
    mkURI,

    -- * Selenium command wrappers
    open,
    click,
    clickAndWait,
    check,
    uncheck,
    typeText,
    isTextPresent,
    isElementPresent,
    isChecked,
    waitForPage,
    waitForCondition,
    keyPress,
    submit,
    selectFrame,
    mouseDown,
    mouseMove,
    mouseUp,
    dragAndDrop,
    dragAndDropToObject,
    getAttribute,
    getBodyText,
    getAllLinks,
    evalJS,
    getSelectedIndex
  ) where

{-
TODO:
  * more convenience functions for creating parameters
-}

import Control.Monad.Error
import Control.Monad.Reader
import Data.Either
import Data.Maybe
import Network.Browser
import Network.BSD
import Network.HTTP
import Network.URI

import Test.Selenium.Pretty
import Test.Selenium.Syntax

--
-- A data type representing a Selenium RC session
--
data SeleniumRCSession =
    SeleniumRCSession {
      -- | The 'HostName' of the Selenium server to connect to
      selHost      :: HostName,
      -- | The port of the Selenium server to connect to
      selPort      :: Int,
      -- | The type of browser to start and use to run the tests
      selBrowser   :: Browser,
      -- | The base URL of the site to be tested
      selURL       :: URI,
      -- | A session ID filled in by 'startSelenium'
      selSessionID :: Maybe String,
      -- | Use Network.Browser instead of Network.HTTP if true
      selUseBrowse :: Bool
    } deriving (Show)

-- | Browser types
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"

------------------------------------------------------------------------
-- | The Selenium Monad, an error-handling read-only state
newtype Selenium a = Selenium (ReaderT SeleniumRCSession (ErrorT String IO) a)
#ifndef __HADDOCK__
    deriving (Functor, Monad, MonadIO, MonadReader SeleniumRCSession
             , MonadError String)
#endif

-- | Run a Selenium action within the ErrorT monad. Useful for chaining
--   together several actions without writing intermediate error handling.
runSeleniumReader :: SeleniumRCSession -> Selenium a -> ErrorT String IO a
runSeleniumReader sel (Selenium body) = runReaderT body sel

-- | Run a Selenium action inside IO. This is the top-level function
-- you'll usually use to run a Selenium command when not using
-- 'withSelenium'.
runSelenium :: SeleniumRCSession -> Selenium a -> IO (Either String a)
runSelenium sel (Selenium body) = runErrorT $ runReaderT body sel

-- | Create an unconnected Selenium session.
mkSeleniumRCSession :: HostName -> Browser -> URI -> SeleniumRCSession
mkSeleniumRCSession seleniumHostName browserType url =
    SeleniumRCSession { selHost      = seleniumHostName
                      , selPort      = 4444
                      , selBrowser   = browserType
                      , selURL       = url
                      , selSessionID = Nothing
                      , selUseBrowse = False}

-- | Start a session, execute some code with the resulting handle, and then
--   stop the session.
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

-- | Connect to the server, and tell it to start a web browser.
startSelenium :: Selenium SeleniumRCSession
startSelenium = do
  sel     <- ask
  session <- doCommand SNewSession [ show (selBrowser sel)
                                   , show (selURL sel) ]
  return $ sel { selSessionID = Just session }

-- | Tell the server that a session is finished.
stopSelenium :: Selenium ()
stopSelenium = do
  doCommand STestComplete []
  return () -- STestComplete might throw errors, but otherwise doesn't
            -- return anything useful.

------------------------------------------------------------------------

-- | Send a Selenium command to the server with a list of arguments.
doCommand :: SCommand -> [String] -> Selenium String
doCommand cmd args = do
  sel <- ask
  let uri = mkURI sel cmd args
  when (isNothing uri) (throwError "created bad URI")
  -- The next line uses fromJust, but it's guaranteed to succeed,
  -- because of the check above.
  let req = Request { rqURI     = fromJust uri
                    , rqMethod  = GET
                    , rqHeaders = []
                    , rqBody    = "" }
  result <- if selUseBrowse sel
              then liftIO $ browse $ get req
              else liftIO $ simpleHTTP req
  let textResult = either
                   (\_ -> "ERROR: HTTP Request failed")
                   (\r -> rspBody r) result
  when (take 5 textResult == "ERROR") (throwError textResult)
  return $ stringResult textResult
  where get req = do setErrHandler error -- XXX: this is awful
                     setOutHandler (const $ return ())
                     rsp <- request req
                     return (Right $ snd rsp)

-- | Execute a list of Selenium commands paired with arguments, and return
-- | a  list of results.
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" <=> 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"

-- TODO: Should this use parsec (or a CSV parser)?
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

------------------------------------------------------------------------
--
-- Selenium syntax lifted into a command
-- More of these would be useful. I've just added them as needed.
--
-- The external API people actually write tests for:
--

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 []

getSelectedIndex              :: Locator -> Selenium Integer
getSelectedIndex locator      = integerCommand SGetSelectedIndex [show locator]
--
-- ToDo: a proper evaluator for these, with arguments in the type.