{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeErrorEvent where

import Data.Aeson.Types
import Hercules.API.Prelude

data AttributeErrorEvent = AttributeErrorEvent
  { AttributeErrorEvent -> [Text]
expressionPath :: [Text],
    AttributeErrorEvent -> Text
errorMessage :: Text,
    AttributeErrorEvent -> Maybe Text
errorDerivation :: Maybe Text,
    AttributeErrorEvent -> Maybe Text
errorType :: Maybe Text,
    AttributeErrorEvent -> Maybe Text
trace :: Maybe Text
  }
  deriving (forall x. Rep AttributeErrorEvent x -> AttributeErrorEvent
forall x. AttributeErrorEvent -> Rep AttributeErrorEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeErrorEvent x -> AttributeErrorEvent
$cfrom :: forall x. AttributeErrorEvent -> Rep AttributeErrorEvent x
Generic, Int -> AttributeErrorEvent -> ShowS
[AttributeErrorEvent] -> ShowS
AttributeErrorEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeErrorEvent] -> ShowS
$cshowList :: [AttributeErrorEvent] -> ShowS
show :: AttributeErrorEvent -> String
$cshow :: AttributeErrorEvent -> String
showsPrec :: Int -> AttributeErrorEvent -> ShowS
$cshowsPrec :: Int -> AttributeErrorEvent -> ShowS
Show, AttributeErrorEvent -> AttributeErrorEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeErrorEvent -> AttributeErrorEvent -> Bool
$c/= :: AttributeErrorEvent -> AttributeErrorEvent -> Bool
== :: AttributeErrorEvent -> AttributeErrorEvent -> Bool
$c== :: AttributeErrorEvent -> AttributeErrorEvent -> Bool
Eq, AttributeErrorEvent -> ()
forall a. (a -> ()) -> NFData a
rnf :: AttributeErrorEvent -> ()
$crnf :: AttributeErrorEvent -> ()
NFData)

instance ToJSON AttributeErrorEvent where
  toJSON :: AttributeErrorEvent -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

  toEncoding :: AttributeErrorEvent -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
aesonOptions

instance FromJSON AttributeErrorEvent where
  parseJSON :: Value -> Parser AttributeErrorEvent
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

aesonOptions :: Options
aesonOptions :: Options
aesonOptions =
  Options
defaultOptions
    { omitNothingFields :: Bool
omitNothingFields = Bool
True
    }