module Test.WebDriver.Exceptions.Internal
( InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..)
, UnknownCommand(..), ServerError(..)
, FailedCommand(..), failedCommand, mkFailedCommandInfo
, FailedCommandType(..), FailedCommandInfo(..), StackFrame(..)
) where
import Test.WebDriver.Session
import Test.WebDriver.JSON
import Data.Aeson
import Data.Aeson.Types (Parser, typeMismatch)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Text (Text)
import qualified Data.Text.Lazy.Encoding as TLE
import Control.Exception (Exception)
import Control.Exception.Lifted (throwIO)
import Control.Applicative
import Data.Typeable (Typeable)
import Data.Maybe (fromMaybe)
import Data.Word
import Prelude
instance Exception InvalidURL
newtype InvalidURL = InvalidURL String
deriving (Eq, Show, Typeable)
instance Exception HTTPStatusUnknown
data HTTPStatusUnknown = HTTPStatusUnknown Int String
deriving (Eq, Show, Typeable)
instance Exception HTTPConnError
data HTTPConnError = HTTPConnError String Int
deriving (Eq, Show, Typeable)
instance Exception UnknownCommand
newtype UnknownCommand = UnknownCommand String
deriving (Eq, Show, Typeable)
instance Exception ServerError
newtype ServerError = ServerError String
deriving (Eq, Show, Typeable)
instance Exception FailedCommand
data FailedCommand = FailedCommand FailedCommandType FailedCommandInfo
deriving (Show, Typeable)
data FailedCommandType = NoSuchElement
| NoSuchFrame
| UnknownFrame
| StaleElementReference
| ElementNotVisible
| InvalidElementState
| UnknownError
| ElementIsNotSelectable
| JavascriptError
| XPathLookupError
| Timeout
| NoSuchWindow
| InvalidCookieDomain
| UnableToSetCookie
| UnexpectedAlertOpen
| NoAlertOpen
| ScriptTimeout
| InvalidElementCoordinates
| IMENotAvailable
| IMEEngineActivationFailed
| InvalidSelector
| SessionNotCreated
| MoveTargetOutOfBounds
| InvalidXPathSelector
| InvalidXPathSelectorReturnType
deriving (Eq, Ord, Enum, Bounded, Show)
data FailedCommandInfo =
FailedCommandInfo {
errMsg :: String
, errSess :: Maybe WDSession
, errScreen :: Maybe ByteString
, errClass :: Maybe String
, errStack :: [StackFrame]
}
instance Show FailedCommandInfo where
show i = showChar '\n'
. showString "Session: " . sess
. showChar '\n'
. showString className . showString ": " . showString (errMsg i)
. showChar '\n'
. foldl (\f s-> f . showString " " . shows s) id (errStack i)
$ ""
where
className = fromMaybe "<unknown exception>" . errClass $ i
sess = case errSess i of
Nothing -> showString "None"
Just WDSession{..} ->
let sessId = maybe "<no session id>" show wdSessId
in showString sessId . showString " at "
. shows wdSessHost . showChar ':' . shows wdSessPort
mkFailedCommandInfo :: (WDSessionState s) => String -> s FailedCommandInfo
mkFailedCommandInfo m = do
sess <- getSession
return $ FailedCommandInfo { errMsg = m
, errSess = Just sess
, errScreen = Nothing
, errClass = Nothing
, errStack = [] }
failedCommand :: (WDSessionStateIO s) => FailedCommandType -> String -> s a
failedCommand t m = throwIO . FailedCommand t =<< mkFailedCommandInfo m
data StackFrame = StackFrame { sfFileName :: String
, sfClassName :: String
, sfMethodName :: String
, sfLineNumber :: Word
}
deriving (Eq)
instance Show StackFrame where
show f = showString (sfClassName f) . showChar '.'
. showString (sfMethodName f) . showChar ' '
. showParen True ( showString (sfFileName f) . showChar ':'
. shows (sfLineNumber f))
$ "\n"
instance FromJSON FailedCommandInfo where
parseJSON (Object o) =
FailedCommandInfo <$> (req "message" >>= maybe (return "") return)
<*> pure Nothing
<*> (fmap TLE.encodeUtf8 <$> opt "screen" Nothing)
<*> opt "class" Nothing
<*> opt "stackTrace" []
where req :: FromJSON a => Text -> Parser a
req = (o .:)
opt :: FromJSON a => Text -> a -> Parser a
opt k d = o .:?? k .!= d
parseJSON v = typeMismatch "FailedCommandInfo" v
instance FromJSON StackFrame where
parseJSON (Object o) = StackFrame <$> reqStr "fileName"
<*> reqStr "className"
<*> reqStr "methodName"
<*> req "lineNumber"
where req :: FromJSON a => Text -> Parser a
req = (o .:)
reqStr :: Text -> Parser String
reqStr k = req k >>= maybe (return "") return
parseJSON v = typeMismatch "StackFrame" v