-- | Discord Interactions
module Calamity.Types.Model.Interaction (
    Interaction (..),
    ApplicationCommandInteractionData (..),
    ApplicationCommandInteractionDataResolved (..),
    InteractionType (..),
) where

import Calamity.Internal.AesonThings
import Calamity.Internal.OverriddenVia
import Calamity.Internal.Utils
import Calamity.Types.Model.Channel (Channel)
import Calamity.Types.Model.Channel.Component
import Calamity.Types.Model.Channel.Message (Message)
import Calamity.Types.Model.Guild (Guild, Role)
import Calamity.Types.Model.Guild.Member (Member)
import Calamity.Types.Model.User (User)
import Calamity.Types.Snowflake
import Data.Aeson
import qualified Data.HashMap.Strict as H
import Data.Scientific (toBoundedInteger)
import qualified Data.Text.Lazy as L
import GHC.Generics
import TextShow
import qualified TextShow.Generic as TSG

data Interaction = Interaction
    { Interaction -> Snowflake Interaction
id :: Snowflake Interaction
    , Interaction -> Snowflake ()
applicationID :: Snowflake ()
    , Interaction -> InteractionType
type_ :: InteractionType
    , Interaction -> Maybe ApplicationCommandInteractionData
data_ :: Maybe ApplicationCommandInteractionData
    , Interaction -> Maybe (Snowflake Guild)
guildID :: Maybe (Snowflake Guild)
    , Interaction -> Maybe (Snowflake Channel)
channelID :: Maybe (Snowflake Channel)
    , Interaction -> Maybe Member
member :: Maybe Member
    , Interaction -> Maybe User
user :: Maybe User
    , Interaction -> Text
token :: L.Text
    , Interaction -> Int
version :: Int
    , Interaction -> Maybe Message
message :: Maybe Message
    }
    deriving (Int -> Interaction -> ShowS
[Interaction] -> ShowS
Interaction -> String
(Int -> Interaction -> ShowS)
-> (Interaction -> String)
-> ([Interaction] -> ShowS)
-> Show Interaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interaction] -> ShowS
$cshowList :: [Interaction] -> ShowS
show :: Interaction -> String
$cshow :: Interaction -> String
showsPrec :: Int -> Interaction -> ShowS
$cshowsPrec :: Int -> Interaction -> ShowS
Show, (forall x. Interaction -> Rep Interaction x)
-> (forall x. Rep Interaction x -> Interaction)
-> Generic Interaction
forall x. Rep Interaction x -> Interaction
forall x. Interaction -> Rep Interaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Interaction x -> Interaction
$cfrom :: forall x. Interaction -> Rep Interaction x
Generic)
    deriving (Int -> Interaction -> Builder
Int -> Interaction -> Text
Int -> Interaction -> Text
[Interaction] -> Builder
[Interaction] -> Text
[Interaction] -> Text
Interaction -> Builder
Interaction -> Text
Interaction -> Text
(Int -> Interaction -> Builder)
-> (Interaction -> Builder)
-> ([Interaction] -> Builder)
-> (Int -> Interaction -> Text)
-> (Interaction -> Text)
-> ([Interaction] -> Text)
-> (Int -> Interaction -> Text)
-> (Interaction -> Text)
-> ([Interaction] -> Text)
-> TextShow Interaction
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [Interaction] -> Text
$cshowtlList :: [Interaction] -> Text
showtl :: Interaction -> Text
$cshowtl :: Interaction -> Text
showtlPrec :: Int -> Interaction -> Text
$cshowtlPrec :: Int -> Interaction -> Text
showtList :: [Interaction] -> Text
$cshowtList :: [Interaction] -> Text
showt :: Interaction -> Text
$cshowt :: Interaction -> Text
showtPrec :: Int -> Interaction -> Text
$cshowtPrec :: Int -> Interaction -> Text
showbList :: [Interaction] -> Builder
$cshowbList :: [Interaction] -> Builder
showb :: Interaction -> Builder
$cshowb :: Interaction -> Builder
showbPrec :: Int -> Interaction -> Builder
$cshowbPrec :: Int -> Interaction -> Builder
TextShow) via TSG.FromGeneric Interaction
    deriving (Value -> Parser [Interaction]
Value -> Parser Interaction
(Value -> Parser Interaction)
-> (Value -> Parser [Interaction]) -> FromJSON Interaction
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Interaction]
$cparseJSONList :: Value -> Parser [Interaction]
parseJSON :: Value -> Parser Interaction
$cparseJSON :: Value -> Parser Interaction
FromJSON) via CalamityJSON Interaction

data ApplicationCommandInteractionData = ApplicationCommandInteractionData
    { ApplicationCommandInteractionData -> Snowflake ()
id :: Snowflake () -- no Command type yet
    , ApplicationCommandInteractionData -> Text
name :: L.Text
    , ApplicationCommandInteractionData
-> Maybe ApplicationCommandInteractionDataResolved
resolved :: Maybe ApplicationCommandInteractionDataResolved
    , -- , options :: [ApplicationCommandInteractionDataOptions]
      -- No commands yet
      ApplicationCommandInteractionData -> Text
customID :: L.Text
    , ApplicationCommandInteractionData -> ComponentType
componentType :: ComponentType
    }
    deriving (Int -> ApplicationCommandInteractionData -> ShowS
[ApplicationCommandInteractionData] -> ShowS
ApplicationCommandInteractionData -> String
(Int -> ApplicationCommandInteractionData -> ShowS)
-> (ApplicationCommandInteractionData -> String)
-> ([ApplicationCommandInteractionData] -> ShowS)
-> Show ApplicationCommandInteractionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandInteractionData] -> ShowS
$cshowList :: [ApplicationCommandInteractionData] -> ShowS
show :: ApplicationCommandInteractionData -> String
$cshow :: ApplicationCommandInteractionData -> String
showsPrec :: Int -> ApplicationCommandInteractionData -> ShowS
$cshowsPrec :: Int -> ApplicationCommandInteractionData -> ShowS
Show, (forall x.
 ApplicationCommandInteractionData
 -> Rep ApplicationCommandInteractionData x)
-> (forall x.
    Rep ApplicationCommandInteractionData x
    -> ApplicationCommandInteractionData)
-> Generic ApplicationCommandInteractionData
forall x.
Rep ApplicationCommandInteractionData x
-> ApplicationCommandInteractionData
forall x.
ApplicationCommandInteractionData
-> Rep ApplicationCommandInteractionData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApplicationCommandInteractionData x
-> ApplicationCommandInteractionData
$cfrom :: forall x.
ApplicationCommandInteractionData
-> Rep ApplicationCommandInteractionData x
Generic)
    deriving (Int -> ApplicationCommandInteractionData -> Builder
Int -> ApplicationCommandInteractionData -> Text
Int -> ApplicationCommandInteractionData -> Text
[ApplicationCommandInteractionData] -> Builder
[ApplicationCommandInteractionData] -> Text
[ApplicationCommandInteractionData] -> Text
ApplicationCommandInteractionData -> Builder
ApplicationCommandInteractionData -> Text
ApplicationCommandInteractionData -> Text
(Int -> ApplicationCommandInteractionData -> Builder)
-> (ApplicationCommandInteractionData -> Builder)
-> ([ApplicationCommandInteractionData] -> Builder)
-> (Int -> ApplicationCommandInteractionData -> Text)
-> (ApplicationCommandInteractionData -> Text)
-> ([ApplicationCommandInteractionData] -> Text)
-> (Int -> ApplicationCommandInteractionData -> Text)
-> (ApplicationCommandInteractionData -> Text)
-> ([ApplicationCommandInteractionData] -> Text)
-> TextShow ApplicationCommandInteractionData
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ApplicationCommandInteractionData] -> Text
$cshowtlList :: [ApplicationCommandInteractionData] -> Text
showtl :: ApplicationCommandInteractionData -> Text
$cshowtl :: ApplicationCommandInteractionData -> Text
showtlPrec :: Int -> ApplicationCommandInteractionData -> Text
$cshowtlPrec :: Int -> ApplicationCommandInteractionData -> Text
showtList :: [ApplicationCommandInteractionData] -> Text
$cshowtList :: [ApplicationCommandInteractionData] -> Text
showt :: ApplicationCommandInteractionData -> Text
$cshowt :: ApplicationCommandInteractionData -> Text
showtPrec :: Int -> ApplicationCommandInteractionData -> Text
$cshowtPrec :: Int -> ApplicationCommandInteractionData -> Text
showbList :: [ApplicationCommandInteractionData] -> Builder
$cshowbList :: [ApplicationCommandInteractionData] -> Builder
showb :: ApplicationCommandInteractionData -> Builder
$cshowb :: ApplicationCommandInteractionData -> Builder
showbPrec :: Int -> ApplicationCommandInteractionData -> Builder
$cshowbPrec :: Int -> ApplicationCommandInteractionData -> Builder
TextShow) via TSG.FromGeneric ApplicationCommandInteractionData
    deriving (Value -> Parser [ApplicationCommandInteractionData]
Value -> Parser ApplicationCommandInteractionData
(Value -> Parser ApplicationCommandInteractionData)
-> (Value -> Parser [ApplicationCommandInteractionData])
-> FromJSON ApplicationCommandInteractionData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ApplicationCommandInteractionData]
$cparseJSONList :: Value -> Parser [ApplicationCommandInteractionData]
parseJSON :: Value -> Parser ApplicationCommandInteractionData
$cparseJSON :: Value -> Parser ApplicationCommandInteractionData
FromJSON) via CalamityJSON ApplicationCommandInteractionData

data ApplicationCommandInteractionDataResolved' = ApplicationCommandInteractionDataResolved'
    { ApplicationCommandInteractionDataResolved'
-> CalamityFromStringShow (HashMap (Snowflake User) User)
users :: CalamityFromStringShow (H.HashMap (Snowflake User) User)
    , ApplicationCommandInteractionDataResolved'
-> CalamityFromStringShow (HashMap (Snowflake Member) Member)
members :: CalamityFromStringShow (H.HashMap (Snowflake Member) Member)
    , ApplicationCommandInteractionDataResolved'
-> CalamityFromStringShow (HashMap (Snowflake Role) Role)
roles :: CalamityFromStringShow (H.HashMap (Snowflake Role) Role)
    , ApplicationCommandInteractionDataResolved'
-> CalamityFromStringShow (HashMap (Snowflake Channel) Channel)
channels :: CalamityFromStringShow (H.HashMap (Snowflake Channel) Channel)
    }
    deriving ((forall x.
 ApplicationCommandInteractionDataResolved'
 -> Rep ApplicationCommandInteractionDataResolved' x)
-> (forall x.
    Rep ApplicationCommandInteractionDataResolved' x
    -> ApplicationCommandInteractionDataResolved')
-> Generic ApplicationCommandInteractionDataResolved'
forall x.
Rep ApplicationCommandInteractionDataResolved' x
-> ApplicationCommandInteractionDataResolved'
forall x.
ApplicationCommandInteractionDataResolved'
-> Rep ApplicationCommandInteractionDataResolved' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApplicationCommandInteractionDataResolved' x
-> ApplicationCommandInteractionDataResolved'
$cfrom :: forall x.
ApplicationCommandInteractionDataResolved'
-> Rep ApplicationCommandInteractionDataResolved' x
Generic)
    deriving (Int -> ApplicationCommandInteractionDataResolved' -> Builder
Int -> ApplicationCommandInteractionDataResolved' -> Text
Int -> ApplicationCommandInteractionDataResolved' -> Text
[ApplicationCommandInteractionDataResolved'] -> Builder
[ApplicationCommandInteractionDataResolved'] -> Text
[ApplicationCommandInteractionDataResolved'] -> Text
ApplicationCommandInteractionDataResolved' -> Builder
ApplicationCommandInteractionDataResolved' -> Text
ApplicationCommandInteractionDataResolved' -> Text
(Int -> ApplicationCommandInteractionDataResolved' -> Builder)
-> (ApplicationCommandInteractionDataResolved' -> Builder)
-> ([ApplicationCommandInteractionDataResolved'] -> Builder)
-> (Int -> ApplicationCommandInteractionDataResolved' -> Text)
-> (ApplicationCommandInteractionDataResolved' -> Text)
-> ([ApplicationCommandInteractionDataResolved'] -> Text)
-> (Int -> ApplicationCommandInteractionDataResolved' -> Text)
-> (ApplicationCommandInteractionDataResolved' -> Text)
-> ([ApplicationCommandInteractionDataResolved'] -> Text)
-> TextShow ApplicationCommandInteractionDataResolved'
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ApplicationCommandInteractionDataResolved'] -> Text
$cshowtlList :: [ApplicationCommandInteractionDataResolved'] -> Text
showtl :: ApplicationCommandInteractionDataResolved' -> Text
$cshowtl :: ApplicationCommandInteractionDataResolved' -> Text
showtlPrec :: Int -> ApplicationCommandInteractionDataResolved' -> Text
$cshowtlPrec :: Int -> ApplicationCommandInteractionDataResolved' -> Text
showtList :: [ApplicationCommandInteractionDataResolved'] -> Text
$cshowtList :: [ApplicationCommandInteractionDataResolved'] -> Text
showt :: ApplicationCommandInteractionDataResolved' -> Text
$cshowt :: ApplicationCommandInteractionDataResolved' -> Text
showtPrec :: Int -> ApplicationCommandInteractionDataResolved' -> Text
$cshowtPrec :: Int -> ApplicationCommandInteractionDataResolved' -> Text
showbList :: [ApplicationCommandInteractionDataResolved'] -> Builder
$cshowbList :: [ApplicationCommandInteractionDataResolved'] -> Builder
showb :: ApplicationCommandInteractionDataResolved' -> Builder
$cshowb :: ApplicationCommandInteractionDataResolved' -> Builder
showbPrec :: Int -> ApplicationCommandInteractionDataResolved' -> Builder
$cshowbPrec :: Int -> ApplicationCommandInteractionDataResolved' -> Builder
TextShow) via TSG.FromGeneric ApplicationCommandInteractionDataResolved'
    deriving (Value -> Parser [ApplicationCommandInteractionDataResolved']
Value -> Parser ApplicationCommandInteractionDataResolved'
(Value -> Parser ApplicationCommandInteractionDataResolved')
-> (Value -> Parser [ApplicationCommandInteractionDataResolved'])
-> FromJSON ApplicationCommandInteractionDataResolved'
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ApplicationCommandInteractionDataResolved']
$cparseJSONList :: Value -> Parser [ApplicationCommandInteractionDataResolved']
parseJSON :: Value -> Parser ApplicationCommandInteractionDataResolved'
$cparseJSON :: Value -> Parser ApplicationCommandInteractionDataResolved'
FromJSON) via CalamityJSON ApplicationCommandInteractionDataResolved'

data ApplicationCommandInteractionDataResolved = ApplicationCommandInteractionDataResolved
    { ApplicationCommandInteractionDataResolved
-> HashMap (Snowflake User) User
users :: H.HashMap (Snowflake User) User
    , ApplicationCommandInteractionDataResolved
-> HashMap (Snowflake Member) Member
members :: H.HashMap (Snowflake Member) Member
    , ApplicationCommandInteractionDataResolved
-> HashMap (Snowflake Role) Role
roles :: H.HashMap (Snowflake Role) Role
    , ApplicationCommandInteractionDataResolved
-> HashMap (Snowflake Channel) Channel
channels :: H.HashMap (Snowflake Channel) Channel
    }
    deriving (Int -> ApplicationCommandInteractionDataResolved -> ShowS
[ApplicationCommandInteractionDataResolved] -> ShowS
ApplicationCommandInteractionDataResolved -> String
(Int -> ApplicationCommandInteractionDataResolved -> ShowS)
-> (ApplicationCommandInteractionDataResolved -> String)
-> ([ApplicationCommandInteractionDataResolved] -> ShowS)
-> Show ApplicationCommandInteractionDataResolved
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandInteractionDataResolved] -> ShowS
$cshowList :: [ApplicationCommandInteractionDataResolved] -> ShowS
show :: ApplicationCommandInteractionDataResolved -> String
$cshow :: ApplicationCommandInteractionDataResolved -> String
showsPrec :: Int -> ApplicationCommandInteractionDataResolved -> ShowS
$cshowsPrec :: Int -> ApplicationCommandInteractionDataResolved -> ShowS
Show, (forall x.
 ApplicationCommandInteractionDataResolved
 -> Rep ApplicationCommandInteractionDataResolved x)
-> (forall x.
    Rep ApplicationCommandInteractionDataResolved x
    -> ApplicationCommandInteractionDataResolved)
-> Generic ApplicationCommandInteractionDataResolved
forall x.
Rep ApplicationCommandInteractionDataResolved x
-> ApplicationCommandInteractionDataResolved
forall x.
ApplicationCommandInteractionDataResolved
-> Rep ApplicationCommandInteractionDataResolved x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApplicationCommandInteractionDataResolved x
-> ApplicationCommandInteractionDataResolved
$cfrom :: forall x.
ApplicationCommandInteractionDataResolved
-> Rep ApplicationCommandInteractionDataResolved x
Generic)
    deriving
        (Int -> ApplicationCommandInteractionDataResolved -> Builder
Int -> ApplicationCommandInteractionDataResolved -> Text
Int -> ApplicationCommandInteractionDataResolved -> Text
[ApplicationCommandInteractionDataResolved] -> Builder
[ApplicationCommandInteractionDataResolved] -> Text
[ApplicationCommandInteractionDataResolved] -> Text
ApplicationCommandInteractionDataResolved -> Builder
ApplicationCommandInteractionDataResolved -> Text
ApplicationCommandInteractionDataResolved -> Text
(Int -> ApplicationCommandInteractionDataResolved -> Builder)
-> (ApplicationCommandInteractionDataResolved -> Builder)
-> ([ApplicationCommandInteractionDataResolved] -> Builder)
-> (Int -> ApplicationCommandInteractionDataResolved -> Text)
-> (ApplicationCommandInteractionDataResolved -> Text)
-> ([ApplicationCommandInteractionDataResolved] -> Text)
-> (Int -> ApplicationCommandInteractionDataResolved -> Text)
-> (ApplicationCommandInteractionDataResolved -> Text)
-> ([ApplicationCommandInteractionDataResolved] -> Text)
-> TextShow ApplicationCommandInteractionDataResolved
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ApplicationCommandInteractionDataResolved] -> Text
$cshowtlList :: [ApplicationCommandInteractionDataResolved] -> Text
showtl :: ApplicationCommandInteractionDataResolved -> Text
$cshowtl :: ApplicationCommandInteractionDataResolved -> Text
showtlPrec :: Int -> ApplicationCommandInteractionDataResolved -> Text
$cshowtlPrec :: Int -> ApplicationCommandInteractionDataResolved -> Text
showtList :: [ApplicationCommandInteractionDataResolved] -> Text
$cshowtList :: [ApplicationCommandInteractionDataResolved] -> Text
showt :: ApplicationCommandInteractionDataResolved -> Text
$cshowt :: ApplicationCommandInteractionDataResolved -> Text
showtPrec :: Int -> ApplicationCommandInteractionDataResolved -> Text
$cshowtPrec :: Int -> ApplicationCommandInteractionDataResolved -> Text
showbList :: [ApplicationCommandInteractionDataResolved] -> Builder
$cshowbList :: [ApplicationCommandInteractionDataResolved] -> Builder
showb :: ApplicationCommandInteractionDataResolved -> Builder
$cshowb :: ApplicationCommandInteractionDataResolved -> Builder
showbPrec :: Int -> ApplicationCommandInteractionDataResolved -> Builder
$cshowbPrec :: Int -> ApplicationCommandInteractionDataResolved -> Builder
TextShow, Value -> Parser [ApplicationCommandInteractionDataResolved]
Value -> Parser ApplicationCommandInteractionDataResolved
(Value -> Parser ApplicationCommandInteractionDataResolved)
-> (Value -> Parser [ApplicationCommandInteractionDataResolved])
-> FromJSON ApplicationCommandInteractionDataResolved
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ApplicationCommandInteractionDataResolved]
$cparseJSONList :: Value -> Parser [ApplicationCommandInteractionDataResolved]
parseJSON :: Value -> Parser ApplicationCommandInteractionDataResolved
$cparseJSON :: Value -> Parser ApplicationCommandInteractionDataResolved
FromJSON)
        via OverriddenVia ApplicationCommandInteractionDataResolved ApplicationCommandInteractionDataResolved'

data InteractionType
    = PingType
    | ApplicationCommandType
    | MessageComponentType
    deriving (Int -> InteractionType -> ShowS
[InteractionType] -> ShowS
InteractionType -> String
(Int -> InteractionType -> ShowS)
-> (InteractionType -> String)
-> ([InteractionType] -> ShowS)
-> Show InteractionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionType] -> ShowS
$cshowList :: [InteractionType] -> ShowS
show :: InteractionType -> String
$cshow :: InteractionType -> String
showsPrec :: Int -> InteractionType -> ShowS
$cshowsPrec :: Int -> InteractionType -> ShowS
Show, (forall x. InteractionType -> Rep InteractionType x)
-> (forall x. Rep InteractionType x -> InteractionType)
-> Generic InteractionType
forall x. Rep InteractionType x -> InteractionType
forall x. InteractionType -> Rep InteractionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InteractionType x -> InteractionType
$cfrom :: forall x. InteractionType -> Rep InteractionType x
Generic)
    deriving (Int -> InteractionType -> Builder
Int -> InteractionType -> Text
Int -> InteractionType -> Text
[InteractionType] -> Builder
[InteractionType] -> Text
[InteractionType] -> Text
InteractionType -> Builder
InteractionType -> Text
InteractionType -> Text
(Int -> InteractionType -> Builder)
-> (InteractionType -> Builder)
-> ([InteractionType] -> Builder)
-> (Int -> InteractionType -> Text)
-> (InteractionType -> Text)
-> ([InteractionType] -> Text)
-> (Int -> InteractionType -> Text)
-> (InteractionType -> Text)
-> ([InteractionType] -> Text)
-> TextShow InteractionType
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [InteractionType] -> Text
$cshowtlList :: [InteractionType] -> Text
showtl :: InteractionType -> Text
$cshowtl :: InteractionType -> Text
showtlPrec :: Int -> InteractionType -> Text
$cshowtlPrec :: Int -> InteractionType -> Text
showtList :: [InteractionType] -> Text
$cshowtList :: [InteractionType] -> Text
showt :: InteractionType -> Text
$cshowt :: InteractionType -> Text
showtPrec :: Int -> InteractionType -> Text
$cshowtPrec :: Int -> InteractionType -> Text
showbList :: [InteractionType] -> Builder
$cshowbList :: [InteractionType] -> Builder
showb :: InteractionType -> Builder
$cshowb :: InteractionType -> Builder
showbPrec :: Int -> InteractionType -> Builder
$cshowbPrec :: Int -> InteractionType -> Builder
TextShow) via TSG.FromGeneric InteractionType

-- instance ToJSON InteractionType where
--     toJSON x = toJSON @Int $ case x of
--         PingType -> 1
--         ApplicationCommandType -> 2
--         MessageComponentType -> 3

--     toEncoding x = toEncoding @Int $ case x of
--         PingType -> 1
--         ApplicationCommandType -> 2
--         MessageComponentType -> 3

instance FromJSON InteractionType where
    parseJSON :: Value -> Parser InteractionType
parseJSON = String
-> (Scientific -> Parser InteractionType)
-> Value
-> Parser InteractionType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"InteractionType" ((Scientific -> Parser InteractionType)
 -> Value -> Parser InteractionType)
-> (Scientific -> Parser InteractionType)
-> Value
-> Parser InteractionType
forall a b. (a -> b) -> a -> b
$ \Scientific
n -> case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger @Int Scientific
n of
        Just Int
1 -> InteractionType -> Parser InteractionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure InteractionType
PingType
        Just Int
2 -> InteractionType -> Parser InteractionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure InteractionType
ApplicationCommandType
        Just Int
3 -> InteractionType -> Parser InteractionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure InteractionType
MessageComponentType
        Maybe Int
_ -> String -> Parser InteractionType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser InteractionType)
-> String -> Parser InteractionType
forall a b. (a -> b) -> a -> b
$ String
"Invalid InteractionType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n