module Patrol.Type.Response
  ( Response(..)
  ) where

import qualified Data.Aeson as Aeson
import qualified Patrol.Type.EventId as EventId
import qualified Patrol.Utility.Json as Json

-- | <https://develop.sentry.dev/sdk/overview/#reading-the-response>
newtype Response = Response
  { Response -> EventId
id_ :: EventId.EventId
  } deriving (Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

instance Aeson.FromJSON Response where
  parseJSON :: Value -> Parser Response
parseJSON = String -> (Object -> Parser Response) -> Value -> Parser Response
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Response" ((Object -> Parser Response) -> Value -> Parser Response)
-> (Object -> Parser Response) -> Value -> Parser Response
forall a b. (a -> b) -> a -> b
$ \ Object
object -> do
    EventId
id_ <- Object -> String -> Parser EventId
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"id"
    Response -> Parser Response
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response :: EventId -> Response
Response { EventId
id_ :: EventId
id_ :: EventId
id_ }