module Patrol.Type.ErrorType where

import qualified Data.Aeson as Aeson

data ErrorType
  = ClockDrift
  | FetchGenericError
  | FetchInvalidEncoding
  | FetchInvalidHttpCode
  | FetchTimeout
  | FetchTooLarge
  | FutureTimestamp
  | InvalidAttribute
  | InvalidData
  | InvalidEnvironment
  | JsFetchTimeout
  | JsGenericFetchError
  | JsInvalidContent
  | JsInvalidHttpCode
  | JsInvalidSourceEncoding
  | JsInvalidSourcemap
  | JsInvalidSourcemapLocation
  | JsMissingSource
  | JsNoColumn
  | JsTooLarge
  | JsTooManyRemoteSources
  | MissingAttribute
  | NativeBadDsym
  | NativeInternalFailure
  | NativeMissingDsym
  | NativeMissingOptionallyBundledDsym
  | NativeMissingSymbol
  | NativeMissingSystemDsym
  | NativeNoCrashedThread
  | NativeSimulatorFrame
  | NativeSymbolicatorFailed
  | NativeUnknownImage
  | PastTimestamp
  | ProguardMissingLineno
  | ProguardMissingMapping
  | RestrictedIp
  | SecurityViolation
  | TooLargeForCache
  | UnknownError
  | ValueTooLong
  deriving (ErrorType -> ErrorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorType -> ErrorType -> Bool
$c/= :: ErrorType -> ErrorType -> Bool
== :: ErrorType -> ErrorType -> Bool
$c== :: ErrorType -> ErrorType -> Bool
Eq, Int -> ErrorType -> ShowS
[ErrorType] -> ShowS
ErrorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorType] -> ShowS
$cshowList :: [ErrorType] -> ShowS
show :: ErrorType -> String
$cshow :: ErrorType -> String
showsPrec :: Int -> ErrorType -> ShowS
$cshowsPrec :: Int -> ErrorType -> ShowS
Show)

instance Aeson.ToJSON ErrorType where
  toJSON :: ErrorType -> Value
toJSON ErrorType
errorType = forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ case ErrorType
errorType of
    ErrorType
ClockDrift -> String
"clock_drift"
    ErrorType
FetchGenericError -> String
"fetch_generic_error"
    ErrorType
FetchInvalidEncoding -> String
"fetch_invalid_source_encoding"
    ErrorType
FetchInvalidHttpCode -> String
"fetch_invalid_http_code"
    ErrorType
FetchTimeout -> String
"fetch_timeout"
    ErrorType
FetchTooLarge -> String
"fetch_too_large"
    ErrorType
FutureTimestamp -> String
"future_timestamp"
    ErrorType
InvalidAttribute -> String
"invalid_attribute"
    ErrorType
InvalidData -> String
"invalid_data"
    ErrorType
InvalidEnvironment -> String
"invalid_environment"
    ErrorType
JsFetchTimeout -> String
"js_fetch_timeout"
    ErrorType
JsGenericFetchError -> String
"js_generic_fetch_error"
    ErrorType
JsInvalidContent -> String
"js_invalid_content"
    ErrorType
JsInvalidHttpCode -> String
"js_invalid_http_code"
    ErrorType
JsInvalidSourceEncoding -> String
"js_invalid_source_encoding"
    ErrorType
JsInvalidSourcemap -> String
"js_invalid_source"
    ErrorType
JsInvalidSourcemapLocation -> String
"js_invalid_sourcemap_location"
    ErrorType
JsMissingSource -> String
"js_no_source"
    ErrorType
JsNoColumn -> String
"js_no_column"
    ErrorType
JsTooLarge -> String
"js_too_large"
    ErrorType
JsTooManyRemoteSources -> String
"js_too_many_sources"
    ErrorType
MissingAttribute -> String
"missing_attribute"
    ErrorType
NativeBadDsym -> String
"native_bad_dsym"
    ErrorType
NativeInternalFailure -> String
"native_internal_failure"
    ErrorType
NativeMissingDsym -> String
"native_missing_dsym"
    ErrorType
NativeMissingOptionallyBundledDsym -> String
"native_optionally_bundled_dsym"
    ErrorType
NativeMissingSymbol -> String
"native_missing_symbol"
    ErrorType
NativeMissingSystemDsym -> String
"native_missing_system_dsym"
    ErrorType
NativeNoCrashedThread -> String
"native_no_crashed_thread"
    ErrorType
NativeSimulatorFrame -> String
"native_simulator_frame"
    ErrorType
NativeSymbolicatorFailed -> String
"native_symbolicator_failed"
    ErrorType
NativeUnknownImage -> String
"native_unknown_image"
    ErrorType
PastTimestamp -> String
"past_timestamp"
    ErrorType
ProguardMissingLineno -> String
"proguard_missing_lineno"
    ErrorType
ProguardMissingMapping -> String
"proguard_missing_mapping"
    ErrorType
RestrictedIp -> String
"restricted_ip"
    ErrorType
SecurityViolation -> String
"security_violation"
    ErrorType
TooLargeForCache -> String
"too_large_for_cache"
    ErrorType
UnknownError -> String
"unknown_error"
    ErrorType
ValueTooLong -> String
"value_too_long"