module Test.WebDriver.Monad
( WD(..), runWD, runSession, finallyClose, closeOnException, getSessionHistory, dumpSessionHistory
) where
import Test.WebDriver.Class
import Test.WebDriver.Session
import Test.WebDriver.Config
import Test.WebDriver.Commands
import Test.WebDriver.Internal
import Control.Monad.Base (MonadBase, liftBase)
import Control.Monad.IO.Class
import Control.Monad.Fix
import Control.Monad.Trans.Control (MonadBaseControl(..), StM)
import Control.Monad.Trans.State.Strict (StateT, evalStateT, get, put)
import Control.Exception.Lifted
import Control.Monad.Catch (MonadThrow, MonadCatch)
import Control.Applicative
import Prelude
newtype WD a = WD (StateT WDSession IO a)
deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadFix)
instance MonadBase IO WD where
liftBase = WD . liftBase
instance MonadBaseControl IO WD where
#if MIN_VERSION_monad_control(1,0,0)
type StM WD a = StM (StateT WDSession IO) a
liftBaseWith f = WD $
liftBaseWith $ \runInBase ->
f (\(WD sT) -> runInBase $ sT)
restoreM = WD . restoreM
#else
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
#endif
instance WDSessionState WD where
getSession = WD get
putSession = WD . put
instance WebDriver WD where
doCommand method path args =
mkRequest method path args
>>= sendHTTPRequest
>>= either throwIO return
>>= getJSONResult
>>= either throwIO return
runWD :: WDSession -> WD a -> IO a
runWD sess (WD wd) = evalStateT wd sess
runSession :: WebDriverConfig conf => conf -> WD a -> IO a
runSession conf wd = do
sess <- mkSession conf
caps <- mkCaps conf
runWD sess $ createSession caps >> wd
finallyClose:: WebDriver wd => wd a -> wd a
finallyClose wd = closeOnException wd <* closeSession
closeOnException :: WebDriver wd => wd a -> wd a
closeOnException wd = wd `onException` closeSession
getSessionHistory :: WDSessionState wd => wd [SessionHistory]
getSessionHistory = fmap wdSessHist getSession
dumpSessionHistory :: WDSessionStateControl wd => wd a -> wd a
dumpSessionHistory = (`finally` (getSession >>= liftBase . print . wdSessHist))