-- | Error information
module OpenAI.V1.Error
    ( -- * Types
      Error(..)
    ) where

import OpenAI.Prelude

-- | More information on the cause of the failure.
--
-- NOTE: OpenAPI API's says that the `code` and `message` fields are required,
-- but in practice the `Error` record can be present with all fields omitted,
-- so they are all marked optional (`Maybe`) here
data Error = Error
    { Error -> Maybe Text
code :: Maybe Text
    , Error -> Maybe Text
message :: Maybe Text
    , Error -> Maybe Text
param :: Maybe Text
    , Error -> Maybe Natural
line :: Maybe Natural
    } deriving stock ((forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show)
      deriving anyclass (Maybe Error
Value -> Parser [Error]
Value -> Parser Error
(Value -> Parser Error)
-> (Value -> Parser [Error]) -> Maybe Error -> FromJSON Error
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Error
parseJSON :: Value -> Parser Error
$cparseJSONList :: Value -> Parser [Error]
parseJSONList :: Value -> Parser [Error]
$comittedField :: Maybe Error
omittedField :: Maybe Error
FromJSON, [Error] -> Value
[Error] -> Encoding
Error -> Bool
Error -> Value
Error -> Encoding
(Error -> Value)
-> (Error -> Encoding)
-> ([Error] -> Value)
-> ([Error] -> Encoding)
-> (Error -> Bool)
-> ToJSON Error
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Error -> Value
toJSON :: Error -> Value
$ctoEncoding :: Error -> Encoding
toEncoding :: Error -> Encoding
$ctoJSONList :: [Error] -> Value
toJSONList :: [Error] -> Value
$ctoEncodingList :: [Error] -> Encoding
toEncodingList :: [Error] -> Encoding
$comitField :: Error -> Bool
omitField :: Error -> Bool
ToJSON)