module Patrol.Type.StackTrace
  ( StackTrace(..)
  , fromCallStack
  ) where

import qualified Data.Aeson as Aeson
import qualified Data.List.NonEmpty as NonEmpty
import qualified GHC.Stack as Stack
import qualified Patrol.Type.Frame as Frame
import qualified Patrol.Utility.Json as Json

-- | <https://develop.sentry.dev/sdk/event-payloads/stacktrace/>
newtype StackTrace = StackTrace
  { StackTrace -> NonEmpty Frame
frames :: NonEmpty.NonEmpty Frame.Frame
  } deriving (StackTrace -> StackTrace -> Bool
(StackTrace -> StackTrace -> Bool)
-> (StackTrace -> StackTrace -> Bool) -> Eq StackTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackTrace -> StackTrace -> Bool
$c/= :: StackTrace -> StackTrace -> Bool
== :: StackTrace -> StackTrace -> Bool
$c== :: StackTrace -> StackTrace -> Bool
Eq, Int -> StackTrace -> ShowS
[StackTrace] -> ShowS
StackTrace -> String
(Int -> StackTrace -> ShowS)
-> (StackTrace -> String)
-> ([StackTrace] -> ShowS)
-> Show StackTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackTrace] -> ShowS
$cshowList :: [StackTrace] -> ShowS
show :: StackTrace -> String
$cshow :: StackTrace -> String
showsPrec :: Int -> StackTrace -> ShowS
$cshowsPrec :: Int -> StackTrace -> ShowS
Show)

instance Aeson.ToJSON StackTrace where
  toJSON :: StackTrace -> Value
toJSON StackTrace
stackTrace = [Pair] -> Value
Aeson.object
    [ String -> NonEmpty Frame -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"frames" (NonEmpty Frame -> Pair) -> NonEmpty Frame -> Pair
forall a b. (a -> b) -> a -> b
$ StackTrace -> NonEmpty Frame
frames StackTrace
stackTrace
    ]

fromCallStack :: Stack.CallStack -> Maybe StackTrace
fromCallStack :: CallStack -> Maybe StackTrace
fromCallStack CallStack
callStack = do
  NonEmpty Frame
frames <- [Frame] -> Maybe (NonEmpty Frame)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([Frame] -> Maybe (NonEmpty Frame))
-> ([(String, SrcLoc)] -> [Frame])
-> [(String, SrcLoc)]
-> Maybe (NonEmpty Frame)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, SrcLoc) -> Frame) -> [(String, SrcLoc)] -> [Frame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> SrcLoc -> Frame) -> (String, SrcLoc) -> Frame
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> SrcLoc -> Frame
Frame.fromSrcLoc) ([(String, SrcLoc)] -> Maybe (NonEmpty Frame))
-> [(String, SrcLoc)] -> Maybe (NonEmpty Frame)
forall a b. (a -> b) -> a -> b
$ CallStack -> [(String, SrcLoc)]
Stack.getCallStack CallStack
callStack
  StackTrace -> Maybe StackTrace
forall (f :: * -> *) a. Applicative f => a -> f a
pure StackTrace :: NonEmpty Frame -> StackTrace
StackTrace { NonEmpty Frame
frames :: NonEmpty Frame
frames :: NonEmpty Frame
frames }