module Test.WebDriver.Session(
WDSessionState(..), modifySession
, WDSession(..), lastHTTPRequest, SessionId(..)
) where
import Data.Aeson
import Data.ByteString as BS(ByteString)
import Data.ByteString.Lazy as LBS(ByteString)
import Data.Text (Text)
import Data.Maybe
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 Network.HTTP.Client (Manager, Request, Response)
newtype SessionId = SessionId Text
deriving (Eq, Ord, Show, Read, FromJSON, ToJSON)
data WDSession = WDSession {
wdSessHost :: BS.ByteString
, wdSessPort :: Int
, wdSessBasePath :: BS.ByteString
, wdSessId :: Maybe SessionId
, wdSessHist :: [(Request, Response LBS.ByteString)]
, wdSessHistUpdate :: (Request, Response LBS.ByteString)
-> [(Request, Response LBS.ByteString)]
-> [(Request, Response LBS.ByteString)]
, wdSessHTTPManager :: Manager
, wdSessHTTPRetryCount :: Int
}
lastHTTPRequest :: WDSession -> Maybe Request
lastHTTPRequest = fmap fst . listToMaybe . wdSessHist
class MonadBaseControl IO s => WDSessionState s where
getSession :: s WDSession
putSession :: WDSession -> s ()
modifySession :: WDSessionState s => (WDSession -> WDSession) -> s ()
modifySession f = getSession >>= putSession . f
instance WDSessionState m => WDSessionState (LS.StateT s m) where
getSession = lift getSession
putSession = lift . putSession
instance WDSessionState m => WDSessionState (SS.StateT s m) where
getSession = lift getSession
putSession = lift . putSession
instance WDSessionState m => WDSessionState (MaybeT m) where
getSession = lift getSession
putSession = lift . putSession
instance WDSessionState m => WDSessionState (IdentityT m) where
getSession = lift getSession
putSession = lift . putSession
instance (Monoid w, WDSessionState m) => WDSessionState (LW.WriterT w m) where
getSession = lift getSession
putSession = lift . putSession
instance WDSessionState m => WDSessionState (ReaderT r m) where
getSession = lift getSession
putSession = lift . putSession
instance (Error e, WDSessionState m) => WDSessionState (ErrorT e m) where
getSession = lift getSession
putSession = lift . putSession
instance (Monoid w, WDSessionState m) => WDSessionState (SRWS.RWST r w s m) where
getSession = lift getSession
putSession = lift . putSession
instance (Monoid w, WDSessionState wd) => WDSessionState (LRWS.RWST r w s wd) where
getSession = lift getSession
putSession = lift . putSession