{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, NamedFieldPuns #-}
module Test.WebDriver.Exceptions.Internal
       ( InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..)
       , UnknownCommand(..), ServerError(..)

       , FailedCommand(..), failedCommand, mkFailedCommandInfo
       , FailedCommandType(..), FailedCommandInfo(..), StackFrame(..)
       , externalCallStack, callStackItemToStackFrame
       ) 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.CallStack
import qualified Data.List as L
import Data.Text (Text)
import qualified Data.Text.Lazy.Encoding as TLE

import Control.Applicative
import Control.Exception (Exception)
import Control.Exception.Lifted (throwIO)

import Data.Maybe (fromMaybe, catMaybes)
import Data.Typeable (Typeable)

import Prelude -- hides some "unused import" warnings

instance Exception InvalidURL
-- |An invalid URL was given
newtype InvalidURL = InvalidURL String
                deriving (InvalidURL -> InvalidURL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidURL -> InvalidURL -> Bool
$c/= :: InvalidURL -> InvalidURL -> Bool
== :: InvalidURL -> InvalidURL -> Bool
$c== :: InvalidURL -> InvalidURL -> Bool
Eq, Int -> InvalidURL -> ShowS
[InvalidURL] -> ShowS
InvalidURL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidURL] -> ShowS
$cshowList :: [InvalidURL] -> ShowS
show :: InvalidURL -> String
$cshow :: InvalidURL -> String
showsPrec :: Int -> InvalidURL -> ShowS
$cshowsPrec :: Int -> InvalidURL -> ShowS
Show, Typeable)

instance Exception HTTPStatusUnknown
-- |An unexpected HTTP status was sent by the server.
data HTTPStatusUnknown = HTTPStatusUnknown Int String
                       deriving (HTTPStatusUnknown -> HTTPStatusUnknown -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTTPStatusUnknown -> HTTPStatusUnknown -> Bool
$c/= :: HTTPStatusUnknown -> HTTPStatusUnknown -> Bool
== :: HTTPStatusUnknown -> HTTPStatusUnknown -> Bool
$c== :: HTTPStatusUnknown -> HTTPStatusUnknown -> Bool
Eq, Int -> HTTPStatusUnknown -> ShowS
[HTTPStatusUnknown] -> ShowS
HTTPStatusUnknown -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTTPStatusUnknown] -> ShowS
$cshowList :: [HTTPStatusUnknown] -> ShowS
show :: HTTPStatusUnknown -> String
$cshow :: HTTPStatusUnknown -> String
showsPrec :: Int -> HTTPStatusUnknown -> ShowS
$cshowsPrec :: Int -> HTTPStatusUnknown -> ShowS
Show, Typeable)

instance Exception HTTPConnError
-- |HTTP connection errors.
data HTTPConnError = HTTPConnError String Int
                   deriving (HTTPConnError -> HTTPConnError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTTPConnError -> HTTPConnError -> Bool
$c/= :: HTTPConnError -> HTTPConnError -> Bool
== :: HTTPConnError -> HTTPConnError -> Bool
$c== :: HTTPConnError -> HTTPConnError -> Bool
Eq, Int -> HTTPConnError -> ShowS
[HTTPConnError] -> ShowS
HTTPConnError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTTPConnError] -> ShowS
$cshowList :: [HTTPConnError] -> ShowS
show :: HTTPConnError -> String
$cshow :: HTTPConnError -> String
showsPrec :: Int -> HTTPConnError -> ShowS
$cshowsPrec :: Int -> HTTPConnError -> ShowS
Show, Typeable)

instance Exception UnknownCommand
-- |A command was sent to the WebDriver server that it didn't recognize.
newtype UnknownCommand = UnknownCommand String
                    deriving (UnknownCommand -> UnknownCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnknownCommand -> UnknownCommand -> Bool
$c/= :: UnknownCommand -> UnknownCommand -> Bool
== :: UnknownCommand -> UnknownCommand -> Bool
$c== :: UnknownCommand -> UnknownCommand -> Bool
Eq, Int -> UnknownCommand -> ShowS
[UnknownCommand] -> ShowS
UnknownCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnknownCommand] -> ShowS
$cshowList :: [UnknownCommand] -> ShowS
show :: UnknownCommand -> String
$cshow :: UnknownCommand -> String
showsPrec :: Int -> UnknownCommand -> ShowS
$cshowsPrec :: Int -> UnknownCommand -> ShowS
Show, Typeable)

instance Exception ServerError
-- |A server-side exception occured
newtype ServerError = ServerError String
                      deriving (ServerError -> ServerError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerError -> ServerError -> Bool
$c/= :: ServerError -> ServerError -> Bool
== :: ServerError -> ServerError -> Bool
$c== :: ServerError -> ServerError -> Bool
Eq, Int -> ServerError -> ShowS
[ServerError] -> ShowS
ServerError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerError] -> ShowS
$cshowList :: [ServerError] -> ShowS
show :: ServerError -> String
$cshow :: ServerError -> String
showsPrec :: Int -> ServerError -> ShowS
$cshowsPrec :: Int -> ServerError -> ShowS
Show, Typeable)

instance Exception FailedCommand
-- |This exception encapsulates a broad variety of exceptions that can
-- occur when a command fails.
data FailedCommand = FailedCommand FailedCommandType FailedCommandInfo
                   deriving (Int -> FailedCommand -> ShowS
[FailedCommand] -> ShowS
FailedCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailedCommand] -> ShowS
$cshowList :: [FailedCommand] -> ShowS
show :: FailedCommand -> String
$cshow :: FailedCommand -> String
showsPrec :: Int -> FailedCommand -> ShowS
$cshowsPrec :: Int -> FailedCommand -> ShowS
Show, Typeable)

-- |The type of failed command exception that occured.
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 (FailedCommandType -> FailedCommandType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailedCommandType -> FailedCommandType -> Bool
$c/= :: FailedCommandType -> FailedCommandType -> Bool
== :: FailedCommandType -> FailedCommandType -> Bool
$c== :: FailedCommandType -> FailedCommandType -> Bool
Eq, Eq FailedCommandType
FailedCommandType -> FailedCommandType -> Bool
FailedCommandType -> FailedCommandType -> Ordering
FailedCommandType -> FailedCommandType -> FailedCommandType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FailedCommandType -> FailedCommandType -> FailedCommandType
$cmin :: FailedCommandType -> FailedCommandType -> FailedCommandType
max :: FailedCommandType -> FailedCommandType -> FailedCommandType
$cmax :: FailedCommandType -> FailedCommandType -> FailedCommandType
>= :: FailedCommandType -> FailedCommandType -> Bool
$c>= :: FailedCommandType -> FailedCommandType -> Bool
> :: FailedCommandType -> FailedCommandType -> Bool
$c> :: FailedCommandType -> FailedCommandType -> Bool
<= :: FailedCommandType -> FailedCommandType -> Bool
$c<= :: FailedCommandType -> FailedCommandType -> Bool
< :: FailedCommandType -> FailedCommandType -> Bool
$c< :: FailedCommandType -> FailedCommandType -> Bool
compare :: FailedCommandType -> FailedCommandType -> Ordering
$ccompare :: FailedCommandType -> FailedCommandType -> Ordering
Ord, Int -> FailedCommandType
FailedCommandType -> Int
FailedCommandType -> [FailedCommandType]
FailedCommandType -> FailedCommandType
FailedCommandType -> FailedCommandType -> [FailedCommandType]
FailedCommandType
-> FailedCommandType -> FailedCommandType -> [FailedCommandType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FailedCommandType
-> FailedCommandType -> FailedCommandType -> [FailedCommandType]
$cenumFromThenTo :: FailedCommandType
-> FailedCommandType -> FailedCommandType -> [FailedCommandType]
enumFromTo :: FailedCommandType -> FailedCommandType -> [FailedCommandType]
$cenumFromTo :: FailedCommandType -> FailedCommandType -> [FailedCommandType]
enumFromThen :: FailedCommandType -> FailedCommandType -> [FailedCommandType]
$cenumFromThen :: FailedCommandType -> FailedCommandType -> [FailedCommandType]
enumFrom :: FailedCommandType -> [FailedCommandType]
$cenumFrom :: FailedCommandType -> [FailedCommandType]
fromEnum :: FailedCommandType -> Int
$cfromEnum :: FailedCommandType -> Int
toEnum :: Int -> FailedCommandType
$ctoEnum :: Int -> FailedCommandType
pred :: FailedCommandType -> FailedCommandType
$cpred :: FailedCommandType -> FailedCommandType
succ :: FailedCommandType -> FailedCommandType
$csucc :: FailedCommandType -> FailedCommandType
Enum, FailedCommandType
forall a. a -> a -> Bounded a
maxBound :: FailedCommandType
$cmaxBound :: FailedCommandType
minBound :: FailedCommandType
$cminBound :: FailedCommandType
Bounded, Int -> FailedCommandType -> ShowS
[FailedCommandType] -> ShowS
FailedCommandType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailedCommandType] -> ShowS
$cshowList :: [FailedCommandType] -> ShowS
show :: FailedCommandType -> String
$cshow :: FailedCommandType -> String
showsPrec :: Int -> FailedCommandType -> ShowS
$cshowsPrec :: Int -> FailedCommandType -> ShowS
Show)

-- |Detailed information about the failed command provided by the server.
data FailedCommandInfo =
  FailedCommandInfo { -- |The error message.
                      FailedCommandInfo -> String
errMsg    :: String
                      -- |The session associated with
                      -- the exception.
                    , FailedCommandInfo -> Maybe WDSession
errSess :: Maybe WDSession
                      -- |A screen shot of the focused window
                      -- when the exception occured,
                      -- if provided.
                    , FailedCommandInfo -> Maybe ByteString
errScreen :: Maybe ByteString
                      -- |The "class" in which the exception
                      -- was raised, if provided.
                    , FailedCommandInfo -> Maybe String
errClass  :: Maybe String
                      -- |A stack trace of the exception.
                    , FailedCommandInfo -> [StackFrame]
errStack  :: [StackFrame]
                    }

-- |Provides a readable printout of the error information, useful for
-- logging.
instance Show FailedCommandInfo where
  show :: FailedCommandInfo -> String
show FailedCommandInfo
i = Char -> ShowS
showChar Char
'\n'
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"Session: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sess
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n'
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
className forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
": " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (FailedCommandInfo -> String
errMsg FailedCommandInfo
i)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n'
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ShowS
f StackFrame
s-> ShowS
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"  " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows StackFrame
s) forall a. a -> a
id (FailedCommandInfo -> [StackFrame]
errStack FailedCommandInfo
i)
           forall a b. (a -> b) -> a -> b
$ String
""
    where
      className :: String
className = forall a. a -> Maybe a -> a
fromMaybe String
"<unknown exception>" forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailedCommandInfo -> Maybe String
errClass forall a b. (a -> b) -> a -> b
$ FailedCommandInfo
i

      sess :: ShowS
sess = case FailedCommandInfo -> Maybe WDSession
errSess FailedCommandInfo
i of
        Maybe WDSession
Nothing -> String -> ShowS
showString String
"None"
        Just WDSession{Int
RequestHeaders
[SessionHistory]
Maybe SessionId
ByteString
Manager
SessionHistoryConfig
wdSessAuthHeaders :: WDSession -> RequestHeaders
wdSessRequestHeaders :: WDSession -> RequestHeaders
wdSessHTTPRetryCount :: WDSession -> Int
wdSessHTTPManager :: WDSession -> Manager
wdSessHistUpdate :: WDSession -> SessionHistoryConfig
wdSessHist :: WDSession -> [SessionHistory]
wdSessId :: WDSession -> Maybe SessionId
wdSessBasePath :: WDSession -> ByteString
wdSessPort :: WDSession -> Int
wdSessHost :: WDSession -> ByteString
wdSessAuthHeaders :: RequestHeaders
wdSessRequestHeaders :: RequestHeaders
wdSessHTTPRetryCount :: Int
wdSessHTTPManager :: Manager
wdSessHistUpdate :: SessionHistoryConfig
wdSessHist :: [SessionHistory]
wdSessId :: Maybe SessionId
wdSessBasePath :: ByteString
wdSessPort :: Int
wdSessHost :: ByteString
..} ->
            let sessId :: String
sessId = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<no session id>" forall a. Show a => a -> String
show Maybe SessionId
wdSessId
            in String -> ShowS
showString String
sessId forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" at "
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows ByteString
wdSessHost forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
wdSessPort


-- |Constructs a FailedCommandInfo from only an error message.
mkFailedCommandInfo :: (WDSessionState s) => String -> CallStack -> s FailedCommandInfo
mkFailedCommandInfo :: forall (s :: * -> *).
WDSessionState s =>
String -> CallStack -> s FailedCommandInfo
mkFailedCommandInfo String
m CallStack
cs = do
  WDSession
sess <- forall (m :: * -> *). WDSessionState m => m WDSession
getSession
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FailedCommandInfo { errMsg :: String
errMsg = String
m
                             , errSess :: Maybe WDSession
errSess = forall a. a -> Maybe a
Just WDSession
sess
                             , errScreen :: Maybe ByteString
errScreen = forall a. Maybe a
Nothing
                             , errClass :: Maybe String
errClass = forall a. Maybe a
Nothing
                             , errStack :: [StackFrame]
errStack = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, SrcLoc) -> StackFrame
callStackItemToStackFrame CallStack
cs }

-- |Use GHC's CallStack capabilities to return a callstack to help debug a FailedCommand.
-- Drops all stack frames inside Test.WebDriver modules, so the first frame on the stack
-- should be where the user called into Test.WebDriver
externalCallStack :: (HasCallStack) => CallStack
externalCallStack :: HasCallStack => CallStack
externalCallStack = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String, SrcLoc) -> Bool
isWebDriverFrame HasCallStack => CallStack
callStack
  where isWebDriverFrame :: ([Char], SrcLoc) -> Bool
        isWebDriverFrame :: (String, SrcLoc) -> Bool
isWebDriverFrame (String
_, SrcLoc {String
srcLocModule :: SrcLoc -> String
srcLocModule :: String
srcLocModule}) = String
"Test.WebDriver" forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
srcLocModule

-- |Convenience function to throw a 'FailedCommand' locally with no server-side
-- info present.
failedCommand :: (HasCallStack, WDSessionStateIO s) => FailedCommandType -> String -> s a
failedCommand :: forall (s :: * -> *) a.
(HasCallStack, WDSessionStateIO s) =>
FailedCommandType -> String -> s a
failedCommand FailedCommandType
t String
m = do
  forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailedCommandType -> FailedCommandInfo -> FailedCommand
FailedCommand FailedCommandType
t forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (s :: * -> *).
WDSessionState s =>
String -> CallStack -> s FailedCommandInfo
mkFailedCommandInfo String
m HasCallStack => CallStack
externalCallStack

-- |An individual stack frame from the stack trace provided by the server
-- during a FailedCommand.
data StackFrame = StackFrame { StackFrame -> String
sfFileName   :: String
                             , StackFrame -> String
sfClassName  :: String
                             , StackFrame -> String
sfMethodName :: String
                             , StackFrame -> Int
sfLineNumber :: Int
                             }
                deriving (StackFrame -> StackFrame -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackFrame -> StackFrame -> Bool
$c/= :: StackFrame -> StackFrame -> Bool
== :: StackFrame -> StackFrame -> Bool
$c== :: StackFrame -> StackFrame -> Bool
Eq)


instance Show StackFrame where
  show :: StackFrame -> String
show StackFrame
f = String -> ShowS
showString (StackFrame -> String
sfClassName StackFrame
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.'
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (StackFrame -> String
sfMethodName StackFrame
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS -> ShowS
showParen Bool
True ( String -> ShowS
showString (StackFrame -> String
sfFileName StackFrame
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':'
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (StackFrame -> Int
sfLineNumber StackFrame
f))
           forall a b. (a -> b) -> a -> b
$ String
"\n"


instance FromJSON FailedCommandInfo where
  parseJSON :: Value -> Parser FailedCommandInfo
parseJSON (Object Object
o) =
    String
-> Maybe WDSession
-> Maybe ByteString
-> Maybe String
-> [StackFrame]
-> FailedCommandInfo
FailedCommandInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Text -> Parser a
req Text
"message" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return String
"") forall (m :: * -> *) a. Monad m => a -> m a
return)
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TLE.encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Text -> a -> Parser a
opt Text
"screen" forall a. Maybe a
Nothing)
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Text -> a -> Parser a
opt Text
"class"      forall a. Maybe a
Nothing
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Text -> a -> Parser a
opt Text
"stackTrace" [])
    where req :: FromJSON a => Text -> Parser a
          req :: forall a. FromJSON a => Text -> Parser a
req = (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
fromText  --required key
          opt :: FromJSON a => Text -> a -> Parser a
          opt :: forall a. FromJSON a => Text -> a -> Parser a
opt Text
k a
d = Object
o forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?? Text
k forall a. Parser (Maybe a) -> a -> Parser a
.!= a
d --optional key
  parseJSON Value
v = forall a. String -> Value -> Parser a
typeMismatch String
"FailedCommandInfo" Value
v

instance FromJSON StackFrame where
  parseJSON :: Value -> Parser StackFrame
parseJSON (Object Object
o) = String -> String -> String -> Int -> StackFrame
StackFrame forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser String
reqStr Text
"fileName"
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser String
reqStr Text
"className"
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser String
reqStr Text
"methodName"
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Text -> Parser a
req    Text
"lineNumber"
    where req :: FromJSON a => Text -> Parser a
          req :: forall a. FromJSON a => Text -> Parser a
req = (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
fromText -- all keys are required
          reqStr :: Text -> Parser String
          reqStr :: Text -> Parser String
reqStr Text
k = forall a. FromJSON a => Text -> Parser a
req Text
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return String
"") forall (m :: * -> *) a. Monad m => a -> m a
return
  parseJSON Value
v = forall a. String -> Value -> Parser a
typeMismatch String
"StackFrame" Value
v


callStackItemToStackFrame :: (String, SrcLoc) -> StackFrame
callStackItemToStackFrame :: (String, SrcLoc) -> StackFrame
callStackItemToStackFrame (String
functionName, SrcLoc {Int
String
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
srcLocModule :: SrcLoc -> String
..}) = StackFrame { sfFileName :: String
sfFileName = String
srcLocFile
                                                                   , sfClassName :: String
sfClassName = String
srcLocModule
                                                                   , sfMethodName :: String
sfMethodName = String
functionName
                                                                   , sfLineNumber :: Int
sfLineNumber = Int
srcLocStartLine
                                                                   }