{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.ResilienceHub.Types.DisruptionType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.ResilienceHub.Types.DisruptionType
  ( DisruptionType
      ( ..,
        DisruptionType_AZ,
        DisruptionType_Hardware,
        DisruptionType_Region,
        DisruptionType_Software
      ),
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

newtype DisruptionType = DisruptionType'
  { DisruptionType -> Text
fromDisruptionType ::
      Data.Text
  }
  deriving stock
    ( Int -> DisruptionType -> ShowS
[DisruptionType] -> ShowS
DisruptionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisruptionType] -> ShowS
$cshowList :: [DisruptionType] -> ShowS
show :: DisruptionType -> String
$cshow :: DisruptionType -> String
showsPrec :: Int -> DisruptionType -> ShowS
$cshowsPrec :: Int -> DisruptionType -> ShowS
Prelude.Show,
      ReadPrec [DisruptionType]
ReadPrec DisruptionType
Int -> ReadS DisruptionType
ReadS [DisruptionType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisruptionType]
$creadListPrec :: ReadPrec [DisruptionType]
readPrec :: ReadPrec DisruptionType
$creadPrec :: ReadPrec DisruptionType
readList :: ReadS [DisruptionType]
$creadList :: ReadS [DisruptionType]
readsPrec :: Int -> ReadS DisruptionType
$creadsPrec :: Int -> ReadS DisruptionType
Prelude.Read,
      DisruptionType -> DisruptionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisruptionType -> DisruptionType -> Bool
$c/= :: DisruptionType -> DisruptionType -> Bool
== :: DisruptionType -> DisruptionType -> Bool
$c== :: DisruptionType -> DisruptionType -> Bool
Prelude.Eq,
      Eq DisruptionType
DisruptionType -> DisruptionType -> Bool
DisruptionType -> DisruptionType -> Ordering
DisruptionType -> DisruptionType -> DisruptionType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DisruptionType -> DisruptionType -> DisruptionType
$cmin :: DisruptionType -> DisruptionType -> DisruptionType
max :: DisruptionType -> DisruptionType -> DisruptionType
$cmax :: DisruptionType -> DisruptionType -> DisruptionType
>= :: DisruptionType -> DisruptionType -> Bool
$c>= :: DisruptionType -> DisruptionType -> Bool
> :: DisruptionType -> DisruptionType -> Bool
$c> :: DisruptionType -> DisruptionType -> Bool
<= :: DisruptionType -> DisruptionType -> Bool
$c<= :: DisruptionType -> DisruptionType -> Bool
< :: DisruptionType -> DisruptionType -> Bool
$c< :: DisruptionType -> DisruptionType -> Bool
compare :: DisruptionType -> DisruptionType -> Ordering
$ccompare :: DisruptionType -> DisruptionType -> Ordering
Prelude.Ord,
      forall x. Rep DisruptionType x -> DisruptionType
forall x. DisruptionType -> Rep DisruptionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisruptionType x -> DisruptionType
$cfrom :: forall x. DisruptionType -> Rep DisruptionType x
Prelude.Generic
    )
  deriving newtype
    ( Eq DisruptionType
Int -> DisruptionType -> Int
DisruptionType -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: DisruptionType -> Int
$chash :: DisruptionType -> Int
hashWithSalt :: Int -> DisruptionType -> Int
$chashWithSalt :: Int -> DisruptionType -> Int
Prelude.Hashable,
      DisruptionType -> ()
forall a. (a -> ()) -> NFData a
rnf :: DisruptionType -> ()
$crnf :: DisruptionType -> ()
Prelude.NFData,
      Text -> Either String DisruptionType
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String DisruptionType
$cfromText :: Text -> Either String DisruptionType
Data.FromText,
      DisruptionType -> Text
forall a. (a -> Text) -> ToText a
toText :: DisruptionType -> Text
$ctoText :: DisruptionType -> Text
Data.ToText,
      DisruptionType -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: DisruptionType -> ByteString
$ctoBS :: DisruptionType -> ByteString
Data.ToByteString,
      DisruptionType -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: DisruptionType -> ByteStringBuilder
$cbuild :: DisruptionType -> ByteStringBuilder
Data.ToLog,
      HeaderName -> DisruptionType -> [Header]
forall a. (HeaderName -> a -> [Header]) -> ToHeader a
toHeader :: HeaderName -> DisruptionType -> [Header]
$ctoHeader :: HeaderName -> DisruptionType -> [Header]
Data.ToHeader,
      DisruptionType -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: DisruptionType -> QueryString
$ctoQuery :: DisruptionType -> QueryString
Data.ToQuery,
      Value -> Parser [DisruptionType]
Value -> Parser DisruptionType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DisruptionType]
$cparseJSONList :: Value -> Parser [DisruptionType]
parseJSON :: Value -> Parser DisruptionType
$cparseJSON :: Value -> Parser DisruptionType
Data.FromJSON,
      FromJSONKeyFunction [DisruptionType]
FromJSONKeyFunction DisruptionType
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [DisruptionType]
$cfromJSONKeyList :: FromJSONKeyFunction [DisruptionType]
fromJSONKey :: FromJSONKeyFunction DisruptionType
$cfromJSONKey :: FromJSONKeyFunction DisruptionType
Data.FromJSONKey,
      [DisruptionType] -> Encoding
[DisruptionType] -> Value
DisruptionType -> Encoding
DisruptionType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DisruptionType] -> Encoding
$ctoEncodingList :: [DisruptionType] -> Encoding
toJSONList :: [DisruptionType] -> Value
$ctoJSONList :: [DisruptionType] -> Value
toEncoding :: DisruptionType -> Encoding
$ctoEncoding :: DisruptionType -> Encoding
toJSON :: DisruptionType -> Value
$ctoJSON :: DisruptionType -> Value
Data.ToJSON,
      ToJSONKeyFunction [DisruptionType]
ToJSONKeyFunction DisruptionType
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [DisruptionType]
$ctoJSONKeyList :: ToJSONKeyFunction [DisruptionType]
toJSONKey :: ToJSONKeyFunction DisruptionType
$ctoJSONKey :: ToJSONKeyFunction DisruptionType
Data.ToJSONKey,
      [Node] -> Either String DisruptionType
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String DisruptionType
$cparseXML :: [Node] -> Either String DisruptionType
Data.FromXML,
      DisruptionType -> XML
forall a. (a -> XML) -> ToXML a
toXML :: DisruptionType -> XML
$ctoXML :: DisruptionType -> XML
Data.ToXML
    )

pattern DisruptionType_AZ :: DisruptionType
pattern $bDisruptionType_AZ :: DisruptionType
$mDisruptionType_AZ :: forall {r}. DisruptionType -> ((# #) -> r) -> ((# #) -> r) -> r
DisruptionType_AZ = DisruptionType' "AZ"

pattern DisruptionType_Hardware :: DisruptionType
pattern $bDisruptionType_Hardware :: DisruptionType
$mDisruptionType_Hardware :: forall {r}. DisruptionType -> ((# #) -> r) -> ((# #) -> r) -> r
DisruptionType_Hardware = DisruptionType' "Hardware"

pattern DisruptionType_Region :: DisruptionType
pattern $bDisruptionType_Region :: DisruptionType
$mDisruptionType_Region :: forall {r}. DisruptionType -> ((# #) -> r) -> ((# #) -> r) -> r
DisruptionType_Region = DisruptionType' "Region"

pattern DisruptionType_Software :: DisruptionType
pattern $bDisruptionType_Software :: DisruptionType
$mDisruptionType_Software :: forall {r}. DisruptionType -> ((# #) -> r) -> ((# #) -> r) -> r
DisruptionType_Software = DisruptionType' "Software"

{-# COMPLETE
  DisruptionType_AZ,
  DisruptionType_Hardware,
  DisruptionType_Region,
  DisruptionType_Software,
  DisruptionType'
  #-}