{-# LANGUAGE OverloadedStrings #-}
module Network.Bugsnag.Exception.Parse
( MessageWithStackFrames(..)
, parseErrorCall
, parseStringException
) where
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
{ mwsfMessage :: Text
, mwsfStackFrames :: [BugsnagStackFrame]
}
parseErrorCall :: ErrorCall -> Either String MessageWithStackFrames
parseErrorCall = parse' errorCallParser
parseStringException :: SomeException -> Either String MessageWithStackFrames
parseStringException = parse' stringExceptionParser
errorCallParser :: Parser MessageWithStackFrames
errorCallParser = MessageWithStackFrames
<$> messageParser
<*> manyTill stackFrameParser eof
where
messageParser :: Parser Text
messageParser = do
msg <- T.pack <$> manyTill anyChar eol
msg <$ (string "CallStack (from HasCallStack):" *> eol)
stackFrameParser :: Parser BugsnagStackFrame
stackFrameParser = do
func <- stackFrameFunctionTill $ string ", called at "
(path, ln, cl) <- stackFrameLocationTill $ eol <|> eof
pure BugsnagStackFrame
{ bsfFile = path
, bsfLineNumber = ln
, bsfColumnNumber = Just cl
, bsfMethod = func
, bsfInProject = Just True
, bsfCode = Nothing
}
stringExceptionParser :: Parser MessageWithStackFrames
stringExceptionParser = MessageWithStackFrames
<$> messageParser
<*> manyTill stackFrameParser eof
where
messageParser :: Parser Text
messageParser = do
manyTill anyChar (try $ string "throwString called with:") *> eol *> eol
T.pack <$> manyTill anyChar (try $ eol *> string "Called from:" *> eol)
stackFrameParser :: Parser BugsnagStackFrame
stackFrameParser = do
func <- stackFrameFunctionTill $ string " ("
(path, ln, cl) <- stackFrameLocationTill $ char ')' *> eol <|> eof
pure BugsnagStackFrame
{ bsfFile = path
, bsfLineNumber = ln
, bsfColumnNumber = Just cl
, bsfMethod = func
, bsfInProject = Just True
, bsfCode = Nothing
}
stackFrameFunctionTill :: Parser a -> Parser Text
stackFrameFunctionTill p = spaces *> (T.pack <$> manyTill anyChar p)
stackFrameLocationTill :: Parser a -> Parser (FilePath, Natural, Natural)
stackFrameLocationTill p = do
result <-
(,,)
<$> manyTill anyChar (char ':')
<*> (read <$> manyTill digit (char ':'))
<*> (read <$> manyTill digit (char ' '))
void $ string "in "
void $ manyTill anyChar $ char ':'
void $ manyTill anyChar p
pure result
parse'
:: Exception e
=> Parser MessageWithStackFrames
-> e
-> Either String MessageWithStackFrames
parse' p = first show . parse (p <* eof) "<error>" . show
eol :: Parser ()
eol = void endOfLine