module Test.WebDriver.Classes
(
WebDriver(..), RequestMethod(..),
SessionState(..), modifySession
, WDSession(..), SessionId(..), defaultSession
) where
import Data.Aeson
import Network.HTTP (RequestMethod(..))
import Network.HTTP.Base (Request)
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.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
class MonadBaseControl IO s => SessionState s where
getSession :: s WDSession
putSession :: WDSession -> s ()
class SessionState wd => WebDriver wd where
doCommand :: (ToJSON a, FromJSON b) =>
RequestMethod
-> Text
-> a
-> wd b
modifySession :: SessionState s => (WDSession -> WDSession) -> s ()
modifySession f = getSession >>= putSession . f
data WDSession = WDSession {
wdHost :: String
, wdPort :: Word16
, wdBasePath :: String
, wdSessId :: Maybe SessionId
, lastHTTPRequest :: Maybe (Request ByteString)
} deriving (Show)
instance Default WDSession where
def = WDSession { wdHost = "127.0.0.1"
, wdPort = 4444
, wdBasePath = "/wd/hub"
, wdSessId = Nothing
, lastHTTPRequest = Nothing
}
defaultSession :: WDSession
defaultSession = def
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 (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)