module Test.WebDriver.Monad
( WD(..), runWD, runSession, withSession, finallyClose, closeOnException
)where
import Test.WebDriver.Classes
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.Trans (lift)
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.Exception.Lifted
import Control.Monad.CatchIO (MonadCatchIO)
import Control.Applicative
newtype WD a = WD (StateT WDSession IO a)
deriving (Functor, Applicative, Monad, MonadIO, MonadCatchIO)
instance MonadBase IO WD where
liftBase = WD . liftBase
instance MonadBaseControl IO WD where
data StM WD a = StWD {unStWD :: StM (StateT WDSession IO) a}
liftBaseWith f = WD $
liftBaseWith $ \runInBase ->
f (\(WD sT) -> liftM StWD . runInBase $ sT)
restoreM = WD . restoreM . unStWD
instance SessionState WD where
getSession = WD get
putSession = WD . put
instance WebDriver WD where
doCommand method path args = do
r <- mkRequest [] method path args
handleHTTPErr r
handleHTTPResp r
runWD :: WDSession -> WD a -> IO a
runWD sess (WD wd) = evalStateT wd sess
runSession :: WDSession -> Capabilities -> WD a -> IO a
runSession s caps wd = runWD s $ createSession caps >> wd <* closeSession
withSession :: WDSession -> WD a -> WD a
withSession s' (WD wd) = WD . lift $ evalStateT wd s'
finallyClose:: WD a -> WD a
finallyClose wd = closeOnException wd <* closeSession
closeOnException :: WD a -> WD a
closeOnException wd = wd `onException` closeSession