module Network.Bugsnag.Exception.Parse
( MessageWithStackFrames(..)
, parseErrorCall
, parseStringException
) where
import Prelude
import Control.Exception (ErrorCall, Exception, SomeException)
import Control.Monad (void)
import Data.Bifunctor (first)
import Data.Text (Text)
import qualified Data.Text as T
import Network.Bugsnag.StackFrame
import Numeric.Natural
import Text.Parsec
import Text.Parsec.String
data MessageWithStackFrames = MessageWithStackFrames
{ MessageWithStackFrames -> Text
mwsfMessage :: Text
, MessageWithStackFrames -> [BugsnagStackFrame]
mwsfStackFrames :: [BugsnagStackFrame]
}
parseErrorCall :: ErrorCall -> Either String MessageWithStackFrames
parseErrorCall :: ErrorCall -> Either String MessageWithStackFrames
parseErrorCall = Parser MessageWithStackFrames
-> ErrorCall -> Either String MessageWithStackFrames
forall e.
Exception e =>
Parser MessageWithStackFrames
-> e -> Either String MessageWithStackFrames
parse' Parser MessageWithStackFrames
errorCallParser
parseStringException :: SomeException -> Either String MessageWithStackFrames
parseStringException :: SomeException -> Either String MessageWithStackFrames
parseStringException = Parser MessageWithStackFrames
-> SomeException -> Either String MessageWithStackFrames
forall e.
Exception e =>
Parser MessageWithStackFrames
-> e -> Either String MessageWithStackFrames
parse' Parser MessageWithStackFrames
stringExceptionParser
errorCallParser :: Parser MessageWithStackFrames
errorCallParser :: Parser MessageWithStackFrames
errorCallParser = Text -> [BugsnagStackFrame] -> MessageWithStackFrames
MessageWithStackFrames
(Text -> [BugsnagStackFrame] -> MessageWithStackFrames)
-> ParsecT String () Identity Text
-> ParsecT
String () Identity ([BugsnagStackFrame] -> MessageWithStackFrames)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Text
messageParser
ParsecT
String () Identity ([BugsnagStackFrame] -> MessageWithStackFrames)
-> ParsecT String () Identity [BugsnagStackFrame]
-> Parser MessageWithStackFrames
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity BugsnagStackFrame
-> ParsecT String () Identity ()
-> ParsecT String () Identity [BugsnagStackFrame]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity BugsnagStackFrame
stackFrameParser ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
where
messageParser :: Parser Text
messageParser :: ParsecT String () Identity Text
messageParser = do
Text
msg <- String -> Text
T.pack (String -> Text)
-> ParsecT String () Identity String
-> ParsecT String () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity ()
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () Identity ()
eol
Text
msg Text
-> ParsecT String () Identity () -> ParsecT String () Identity Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"CallStack (from HasCallStack):" ParsecT String () Identity String
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity ()
eol)
stackFrameParser :: Parser BugsnagStackFrame
stackFrameParser :: ParsecT String () Identity BugsnagStackFrame
stackFrameParser = do
Text
func <- ParsecT String () Identity String
-> ParsecT String () Identity Text
forall a. Parser a -> ParsecT String () Identity Text
stackFrameFunctionTill (ParsecT String () Identity String
-> ParsecT String () Identity Text)
-> ParsecT String () Identity String
-> ParsecT String () Identity Text
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
", called at "
(String
path, Natural
ln, Natural
cl) <- ParsecT String () Identity () -> Parser (String, Natural, Natural)
forall a. Parser a -> Parser (String, Natural, Natural)
stackFrameLocationTill (ParsecT String () Identity ()
-> Parser (String, Natural, Natural))
-> ParsecT String () Identity ()
-> Parser (String, Natural, Natural)
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity ()
eol ParsecT String () Identity ()
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
BugsnagStackFrame -> ParsecT String () Identity BugsnagStackFrame
forall (f :: * -> *) a. Applicative f => a -> f a
pure BugsnagStackFrame :: String
-> Natural
-> Maybe Natural
-> Text
-> Maybe Bool
-> Maybe BugsnagCode
-> BugsnagStackFrame
BugsnagStackFrame
{ bsfFile :: String
bsfFile = String
path
, bsfLineNumber :: Natural
bsfLineNumber = Natural
ln
, bsfColumnNumber :: Maybe Natural
bsfColumnNumber = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
cl
, bsfMethod :: Text
bsfMethod = Text
func
, bsfInProject :: Maybe Bool
bsfInProject = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
, bsfCode :: Maybe BugsnagCode
bsfCode = Maybe BugsnagCode
forall a. Maybe a
Nothing
}
stringExceptionParser :: Parser MessageWithStackFrames
stringExceptionParser :: Parser MessageWithStackFrames
stringExceptionParser = Text -> [BugsnagStackFrame] -> MessageWithStackFrames
MessageWithStackFrames
(Text -> [BugsnagStackFrame] -> MessageWithStackFrames)
-> ParsecT String () Identity Text
-> ParsecT
String () Identity ([BugsnagStackFrame] -> MessageWithStackFrames)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Text
messageParser
ParsecT
String () Identity ([BugsnagStackFrame] -> MessageWithStackFrames)
-> ParsecT String () Identity [BugsnagStackFrame]
-> Parser MessageWithStackFrames
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity BugsnagStackFrame
-> ParsecT String () Identity ()
-> ParsecT String () Identity [BugsnagStackFrame]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity BugsnagStackFrame
stackFrameParser ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
where
messageParser :: Parser Text
messageParser :: ParsecT String () Identity Text
messageParser = do
ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String
-> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"throwString called with:") ParsecT String () Identity String
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity ()
eol ParsecT String () Identity ()
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity ()
eol
String -> Text
T.pack (String -> Text)
-> ParsecT String () Identity String
-> ParsecT String () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity ()
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity () -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity () -> ParsecT String () Identity ())
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity ()
eol ParsecT String () Identity ()
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Called from:" ParsecT String () Identity String
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity ()
eol)
stackFrameParser :: Parser BugsnagStackFrame
stackFrameParser :: ParsecT String () Identity BugsnagStackFrame
stackFrameParser = do
Text
func <- ParsecT String () Identity String
-> ParsecT String () Identity Text
forall a. Parser a -> ParsecT String () Identity Text
stackFrameFunctionTill (ParsecT String () Identity String
-> ParsecT String () Identity Text)
-> ParsecT String () Identity String
-> ParsecT String () Identity Text
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
" ("
(String
path, Natural
ln, Natural
cl) <- ParsecT String () Identity () -> Parser (String, Natural, Natural)
forall a. Parser a -> Parser (String, Natural, Natural)
stackFrameLocationTill (ParsecT String () Identity ()
-> Parser (String, Natural, Natural))
-> ParsecT String () Identity ()
-> Parser (String, Natural, Natural)
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')' ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity ()
eol ParsecT String () Identity ()
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
BugsnagStackFrame -> ParsecT String () Identity BugsnagStackFrame
forall (f :: * -> *) a. Applicative f => a -> f a
pure BugsnagStackFrame :: String
-> Natural
-> Maybe Natural
-> Text
-> Maybe Bool
-> Maybe BugsnagCode
-> BugsnagStackFrame
BugsnagStackFrame
{ bsfFile :: String
bsfFile = String
path
, bsfLineNumber :: Natural
bsfLineNumber = Natural
ln
, bsfColumnNumber :: Maybe Natural
bsfColumnNumber = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
cl
, bsfMethod :: Text
bsfMethod = Text
func
, bsfInProject :: Maybe Bool
bsfInProject = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
, bsfCode :: Maybe BugsnagCode
bsfCode = Maybe BugsnagCode
forall a. Maybe a
Nothing
}
stackFrameFunctionTill :: Parser a -> Parser Text
stackFrameFunctionTill :: Parser a -> ParsecT String () Identity Text
stackFrameFunctionTill Parser a
p = ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity Text
-> ParsecT String () Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Text
T.pack (String -> Text)
-> ParsecT String () Identity String
-> ParsecT String () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> Parser a -> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar Parser a
p)
stackFrameLocationTill :: Parser a -> Parser (FilePath, Natural, Natural)
stackFrameLocationTill :: Parser a -> Parser (String, Natural, Natural)
stackFrameLocationTill Parser a
p = do
(String, Natural, Natural)
result <-
(,,)
(String -> Natural -> Natural -> (String, Natural, Natural))
-> ParsecT String () Identity String
-> ParsecT
String
()
Identity
(Natural -> Natural -> (String, Natural, Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
ParsecT
String
()
Identity
(Natural -> Natural -> (String, Natural, Natural))
-> ParsecT String () Identity Natural
-> ParsecT
String () Identity (Natural -> (String, Natural, Natural))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Natural
forall a. Read a => String -> a
read (String -> Natural)
-> ParsecT String () Identity String
-> ParsecT String () Identity Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'))
ParsecT String () Identity (Natural -> (String, Natural, Natural))
-> ParsecT String () Identity Natural
-> Parser (String, Natural, Natural)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Natural
forall a. Read a => String -> a
read (String -> Natural)
-> ParsecT String () Identity String
-> ParsecT String () Identity Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '))
ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
-> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"in "
ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
-> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity Char
-> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
-> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> Parser a -> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar Parser a
p
(String, Natural, Natural) -> Parser (String, Natural, Natural)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String, Natural, Natural)
result
parse'
:: Exception e
=> Parser MessageWithStackFrames
-> e
-> Either String MessageWithStackFrames
parse' :: Parser MessageWithStackFrames
-> e -> Either String MessageWithStackFrames
parse' Parser MessageWithStackFrames
p = (ParseError -> String)
-> Either ParseError MessageWithStackFrames
-> Either String MessageWithStackFrames
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError -> String
forall a. Show a => a -> String
show (Either ParseError MessageWithStackFrames
-> Either String MessageWithStackFrames)
-> (e -> Either ParseError MessageWithStackFrames)
-> e
-> Either String MessageWithStackFrames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MessageWithStackFrames
-> String -> String -> Either ParseError MessageWithStackFrames
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parser MessageWithStackFrames
p Parser MessageWithStackFrames
-> ParsecT String () Identity () -> Parser MessageWithStackFrames
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
"<error>" (String -> Either ParseError MessageWithStackFrames)
-> (e -> String) -> e -> Either ParseError MessageWithStackFrames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show
eol :: Parser ()
eol :: ParsecT String () Identity ()
eol = ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine