{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

module Discord.Internal.Types.Interactions
  ( Interaction (..),
    InteractionDataComponent (..),
    InteractionDataApplicationCommand (..),
    InteractionDataApplicationCommandOptions (..),
    InteractionDataApplicationCommandOptionSubcommandOrGroup (..),
    InteractionDataApplicationCommandOptionSubcommand (..),
    InteractionDataApplicationCommandOptionValue (..),
    InteractionToken,
    ResolvedData (..),
    MemberOrUser (..),
    InteractionResponse (..),
    interactionResponseBasic,
    InteractionResponseAutocomplete (..),
    InteractionResponseMessage (..),
    interactionResponseMessageBasic,
    InteractionResponseMessageFlags (..),
    InteractionResponseMessageFlag (..),
    InteractionResponseModalData (..),
  )
where

import Control.Applicative (Alternative ((<|>)))
import Control.Monad (join)
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Bits (Bits (shift, (.|.)))
import Data.Foldable (Foldable (toList))
import Data.Scientific (Scientific)
import qualified Data.Text as T
import Discord.Internal.Types.ApplicationCommands (Choice)
import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message)
import Discord.Internal.Types.Components (ComponentActionRow, ComponentTextInput)
import Discord.Internal.Types.Embed (CreateEmbed, createEmbed)
import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, ChannelId, GuildId, InteractionId, InteractionToken, MessageId, RoleId, Snowflake, UserId)
import Discord.Internal.Types.User (GuildMember, User)

-- | An interaction received from discord.
data Interaction
  = InteractionComponent
      { -- | The id of this interaction.
        Interaction -> InteractionId
interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        Interaction -> InteractionId
interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        Interaction -> InteractionDataComponent
interactionDataComponent :: InteractionDataComponent,
        -- | What guild this interaction comes from.
        Interaction -> Maybe InteractionId
interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        Interaction -> Maybe InteractionId
interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        Interaction -> MemberOrUser
interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        Interaction -> InteractionToken
interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        Interaction -> Int
interactionVersion :: Int,
        -- | What message is associated with this interaction.
        Interaction -> Message
interactionMessage :: Message,
        -- | The invoking user's preferred locale.
        Interaction -> InteractionToken
interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        Interaction -> Maybe InteractionToken
interactionGuildLocale :: Maybe T.Text
      }
  | InteractionPing
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int
      }
  | InteractionApplicationCommand
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        Interaction -> InteractionDataApplicationCommand
interactionDataApplicationCommand :: InteractionDataApplicationCommand,
        -- | What guild this interaction comes from.
        interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int,
        -- | The invoking user's preferred locale.
        interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        interactionGuildLocale :: Maybe T.Text
      }
  | InteractionApplicationCommandAutocomplete
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        interactionDataApplicationCommand :: InteractionDataApplicationCommand,
        -- | What guild this interaction comes from.
        interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int,
        -- | The invoking user's preferred locale.
        interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        interactionGuildLocale :: Maybe T.Text
      }
  | InteractionModalSubmit
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        Interaction -> InteractionDataModal
interactionDataModal :: InteractionDataModal,
        -- | What guild this interaction comes from.
        interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int,
        -- | The invoking user's preferred locale.
        interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        interactionGuildLocale :: Maybe T.Text
      }
  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, ReadPrec [Interaction]
ReadPrec Interaction
Int -> ReadS Interaction
ReadS [Interaction]
(Int -> ReadS Interaction)
-> ReadS [Interaction]
-> ReadPrec Interaction
-> ReadPrec [Interaction]
-> Read Interaction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Interaction]
$creadListPrec :: ReadPrec [Interaction]
readPrec :: ReadPrec Interaction
$creadPrec :: ReadPrec Interaction
readList :: ReadS [Interaction]
$creadList :: ReadS [Interaction]
readsPrec :: Int -> ReadS Interaction
$creadsPrec :: Int -> ReadS Interaction
Read, Interaction -> Interaction -> Bool
(Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool) -> Eq Interaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interaction -> Interaction -> Bool
$c/= :: Interaction -> Interaction -> Bool
== :: Interaction -> Interaction -> Bool
$c== :: Interaction -> Interaction -> Bool
Eq, Eq Interaction
Eq Interaction
-> (Interaction -> Interaction -> Ordering)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Interaction)
-> (Interaction -> Interaction -> Interaction)
-> Ord Interaction
Interaction -> Interaction -> Bool
Interaction -> Interaction -> Ordering
Interaction -> Interaction -> Interaction
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 :: Interaction -> Interaction -> Interaction
$cmin :: Interaction -> Interaction -> Interaction
max :: Interaction -> Interaction -> Interaction
$cmax :: Interaction -> Interaction -> Interaction
>= :: Interaction -> Interaction -> Bool
$c>= :: Interaction -> Interaction -> Bool
> :: Interaction -> Interaction -> Bool
$c> :: Interaction -> Interaction -> Bool
<= :: Interaction -> Interaction -> Bool
$c<= :: Interaction -> Interaction -> Bool
< :: Interaction -> Interaction -> Bool
$c< :: Interaction -> Interaction -> Bool
compare :: Interaction -> Interaction -> Ordering
$ccompare :: Interaction -> Interaction -> Ordering
$cp1Ord :: Eq Interaction
Ord)

instance FromJSON Interaction where
  parseJSON :: Value -> Parser Interaction
parseJSON =
    String
-> (Object -> Parser Interaction) -> Value -> Parser Interaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"Interaction"
      ( \Object
v -> do
          InteractionId
iid <- Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          InteractionId
aid <- Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
          Maybe InteractionId
gid <- Object
v Object -> Key -> Parser (Maybe InteractionId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
          Maybe InteractionId
cid <- Object
v Object -> Key -> Parser (Maybe InteractionId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_id"
          InteractionToken
tok <- Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
          Int
version <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
          Maybe InteractionToken
glocale <- Object
v Object -> Key -> Parser (Maybe InteractionToken)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_locale"
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 -> Interaction -> Parser Interaction
forall (m :: * -> *) a. Monad m => a -> m a
return (Interaction -> Parser Interaction)
-> Interaction -> Parser Interaction
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionId -> InteractionToken -> Int -> Interaction
InteractionPing InteractionId
iid InteractionId
aid InteractionToken
tok Int
version
            Int
2 ->
              InteractionId
-> InteractionId
-> InteractionDataApplicationCommand
-> Maybe InteractionId
-> Maybe InteractionId
-> MemberOrUser
-> InteractionToken
-> Int
-> InteractionToken
-> Maybe InteractionToken
-> Interaction
InteractionApplicationCommand InteractionId
iid InteractionId
aid
                (InteractionDataApplicationCommand
 -> Maybe InteractionId
 -> Maybe InteractionId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> InteractionToken
 -> Maybe InteractionToken
 -> Interaction)
-> Parser InteractionDataApplicationCommand
-> Parser
     (Maybe InteractionId
      -> Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionDataApplicationCommand
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe InteractionId
   -> Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
gid
                Parser
  (Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser InteractionToken
-> Parser
     (Int -> InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser
  (Int -> InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser Int
-> Parser
     (InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser (InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser InteractionToken
-> Parser (Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe InteractionToken -> Interaction)
-> Parser (Maybe InteractionToken) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionToken -> Parser (Maybe InteractionToken)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionToken
glocale
            Int
3 ->
              InteractionId
-> InteractionId
-> InteractionDataComponent
-> Maybe InteractionId
-> Maybe InteractionId
-> MemberOrUser
-> InteractionToken
-> Int
-> Message
-> InteractionToken
-> Maybe InteractionToken
-> Interaction
InteractionComponent InteractionId
iid InteractionId
aid
                (InteractionDataComponent
 -> Maybe InteractionId
 -> Maybe InteractionId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Message
 -> InteractionToken
 -> Maybe InteractionToken
 -> Interaction)
-> Parser InteractionDataComponent
-> Parser
     (Maybe InteractionId
      -> Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionDataComponent
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe InteractionId
   -> Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
gid
                Parser
  (Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int
      -> Message
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int
   -> Message
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser InteractionToken
-> Parser
     (Int
      -> Message
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser
  (Int
   -> Message
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser Int
-> Parser
     (Message
      -> InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser
  (Message
   -> InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser Message
-> Parser
     (InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Message
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
                Parser (InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser InteractionToken
-> Parser (Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe InteractionToken -> Interaction)
-> Parser (Maybe InteractionToken) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionToken -> Parser (Maybe InteractionToken)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionToken
glocale
            Int
4 ->
              InteractionId
-> InteractionId
-> InteractionDataApplicationCommand
-> Maybe InteractionId
-> Maybe InteractionId
-> MemberOrUser
-> InteractionToken
-> Int
-> InteractionToken
-> Maybe InteractionToken
-> Interaction
InteractionApplicationCommandAutocomplete InteractionId
iid InteractionId
aid
                (InteractionDataApplicationCommand
 -> Maybe InteractionId
 -> Maybe InteractionId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> InteractionToken
 -> Maybe InteractionToken
 -> Interaction)
-> Parser InteractionDataApplicationCommand
-> Parser
     (Maybe InteractionId
      -> Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionDataApplicationCommand
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe InteractionId
   -> Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
gid
                Parser
  (Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser InteractionToken
-> Parser
     (Int -> InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser
  (Int -> InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser Int
-> Parser
     (InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser (InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser InteractionToken
-> Parser (Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe InteractionToken -> Interaction)
-> Parser (Maybe InteractionToken) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionToken -> Parser (Maybe InteractionToken)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionToken
glocale
            Int
5 ->
              InteractionId
-> InteractionId
-> InteractionDataModal
-> Maybe InteractionId
-> Maybe InteractionId
-> MemberOrUser
-> InteractionToken
-> Int
-> InteractionToken
-> Maybe InteractionToken
-> Interaction
InteractionModalSubmit InteractionId
iid InteractionId
aid
                (InteractionDataModal
 -> Maybe InteractionId
 -> Maybe InteractionId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> InteractionToken
 -> Maybe InteractionToken
 -> Interaction)
-> Parser InteractionDataModal
-> Parser
     (Maybe InteractionId
      -> Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionDataModal
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe InteractionId
   -> Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (Maybe InteractionId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
gid
                Parser
  (Maybe InteractionId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser (Maybe InteractionId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionId -> Parser (Maybe InteractionId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int
      -> InteractionToken
      -> Maybe InteractionToken
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int
   -> InteractionToken
   -> Maybe InteractionToken
   -> Interaction)
-> Parser InteractionToken
-> Parser
     (Int -> InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser
  (Int -> InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser Int
-> Parser
     (InteractionToken -> Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser (InteractionToken -> Maybe InteractionToken -> Interaction)
-> Parser InteractionToken
-> Parser (Maybe InteractionToken -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe InteractionToken -> Interaction)
-> Parser (Maybe InteractionToken) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe InteractionToken -> Parser (Maybe InteractionToken)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InteractionToken
glocale
            Int
_ -> String -> Parser Interaction
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown interaction type"
      )

newtype MemberOrUser = MemberOrUser (Either GuildMember User)
  deriving (Int -> MemberOrUser -> ShowS
[MemberOrUser] -> ShowS
MemberOrUser -> String
(Int -> MemberOrUser -> ShowS)
-> (MemberOrUser -> String)
-> ([MemberOrUser] -> ShowS)
-> Show MemberOrUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemberOrUser] -> ShowS
$cshowList :: [MemberOrUser] -> ShowS
show :: MemberOrUser -> String
$cshow :: MemberOrUser -> String
showsPrec :: Int -> MemberOrUser -> ShowS
$cshowsPrec :: Int -> MemberOrUser -> ShowS
Show, ReadPrec [MemberOrUser]
ReadPrec MemberOrUser
Int -> ReadS MemberOrUser
ReadS [MemberOrUser]
(Int -> ReadS MemberOrUser)
-> ReadS [MemberOrUser]
-> ReadPrec MemberOrUser
-> ReadPrec [MemberOrUser]
-> Read MemberOrUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MemberOrUser]
$creadListPrec :: ReadPrec [MemberOrUser]
readPrec :: ReadPrec MemberOrUser
$creadPrec :: ReadPrec MemberOrUser
readList :: ReadS [MemberOrUser]
$creadList :: ReadS [MemberOrUser]
readsPrec :: Int -> ReadS MemberOrUser
$creadsPrec :: Int -> ReadS MemberOrUser
Read, MemberOrUser -> MemberOrUser -> Bool
(MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool) -> Eq MemberOrUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemberOrUser -> MemberOrUser -> Bool
$c/= :: MemberOrUser -> MemberOrUser -> Bool
== :: MemberOrUser -> MemberOrUser -> Bool
$c== :: MemberOrUser -> MemberOrUser -> Bool
Eq, Eq MemberOrUser
Eq MemberOrUser
-> (MemberOrUser -> MemberOrUser -> Ordering)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> MemberOrUser)
-> (MemberOrUser -> MemberOrUser -> MemberOrUser)
-> Ord MemberOrUser
MemberOrUser -> MemberOrUser -> Bool
MemberOrUser -> MemberOrUser -> Ordering
MemberOrUser -> MemberOrUser -> MemberOrUser
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 :: MemberOrUser -> MemberOrUser -> MemberOrUser
$cmin :: MemberOrUser -> MemberOrUser -> MemberOrUser
max :: MemberOrUser -> MemberOrUser -> MemberOrUser
$cmax :: MemberOrUser -> MemberOrUser -> MemberOrUser
>= :: MemberOrUser -> MemberOrUser -> Bool
$c>= :: MemberOrUser -> MemberOrUser -> Bool
> :: MemberOrUser -> MemberOrUser -> Bool
$c> :: MemberOrUser -> MemberOrUser -> Bool
<= :: MemberOrUser -> MemberOrUser -> Bool
$c<= :: MemberOrUser -> MemberOrUser -> Bool
< :: MemberOrUser -> MemberOrUser -> Bool
$c< :: MemberOrUser -> MemberOrUser -> Bool
compare :: MemberOrUser -> MemberOrUser -> Ordering
$ccompare :: MemberOrUser -> MemberOrUser -> Ordering
$cp1Ord :: Eq MemberOrUser
Ord)

instance {-# OVERLAPPING #-} FromJSON MemberOrUser where
  parseJSON :: Value -> Parser MemberOrUser
parseJSON =
    String
-> (Object -> Parser MemberOrUser) -> Value -> Parser MemberOrUser
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"MemberOrUser"
      ( \Object
v -> Either GuildMember User -> MemberOrUser
MemberOrUser (Either GuildMember User -> MemberOrUser)
-> Parser (Either GuildMember User) -> Parser MemberOrUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GuildMember -> Either GuildMember User
forall a b. a -> Either a b
Left (GuildMember -> Either GuildMember User)
-> Parser GuildMember -> Parser (Either GuildMember User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser GuildMember
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"member") Parser (Either GuildMember User)
-> Parser (Either GuildMember User)
-> Parser (Either GuildMember User)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (User -> Either GuildMember User
forall a b. b -> Either a b
Right (User -> Either GuildMember User)
-> Parser User -> Parser (Either GuildMember User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"))
      )

data InteractionDataComponent
  = InteractionDataComponentButton
      { -- | The unique id of the component (up to 100 characters).
        InteractionDataComponent -> InteractionToken
interactionDataComponentCustomId :: T.Text
      }
  | InteractionDataComponentSelectMenu
      { -- | The unique id of the component (up to 100 characters).
        interactionDataComponentCustomId :: T.Text,
        -- | Values for the select menu.
        InteractionDataComponent -> [InteractionToken]
interactionDataComponentValues :: [T.Text]
      }
  deriving (Int -> InteractionDataComponent -> ShowS
[InteractionDataComponent] -> ShowS
InteractionDataComponent -> String
(Int -> InteractionDataComponent -> ShowS)
-> (InteractionDataComponent -> String)
-> ([InteractionDataComponent] -> ShowS)
-> Show InteractionDataComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataComponent] -> ShowS
$cshowList :: [InteractionDataComponent] -> ShowS
show :: InteractionDataComponent -> String
$cshow :: InteractionDataComponent -> String
showsPrec :: Int -> InteractionDataComponent -> ShowS
$cshowsPrec :: Int -> InteractionDataComponent -> ShowS
Show, ReadPrec [InteractionDataComponent]
ReadPrec InteractionDataComponent
Int -> ReadS InteractionDataComponent
ReadS [InteractionDataComponent]
(Int -> ReadS InteractionDataComponent)
-> ReadS [InteractionDataComponent]
-> ReadPrec InteractionDataComponent
-> ReadPrec [InteractionDataComponent]
-> Read InteractionDataComponent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataComponent]
$creadListPrec :: ReadPrec [InteractionDataComponent]
readPrec :: ReadPrec InteractionDataComponent
$creadPrec :: ReadPrec InteractionDataComponent
readList :: ReadS [InteractionDataComponent]
$creadList :: ReadS [InteractionDataComponent]
readsPrec :: Int -> ReadS InteractionDataComponent
$creadsPrec :: Int -> ReadS InteractionDataComponent
Read, InteractionDataComponent -> InteractionDataComponent -> Bool
(InteractionDataComponent -> InteractionDataComponent -> Bool)
-> (InteractionDataComponent -> InteractionDataComponent -> Bool)
-> Eq InteractionDataComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c/= :: InteractionDataComponent -> InteractionDataComponent -> Bool
== :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c== :: InteractionDataComponent -> InteractionDataComponent -> Bool
Eq, Eq InteractionDataComponent
Eq InteractionDataComponent
-> (InteractionDataComponent
    -> InteractionDataComponent -> Ordering)
-> (InteractionDataComponent -> InteractionDataComponent -> Bool)
-> (InteractionDataComponent -> InteractionDataComponent -> Bool)
-> (InteractionDataComponent -> InteractionDataComponent -> Bool)
-> (InteractionDataComponent -> InteractionDataComponent -> Bool)
-> (InteractionDataComponent
    -> InteractionDataComponent -> InteractionDataComponent)
-> (InteractionDataComponent
    -> InteractionDataComponent -> InteractionDataComponent)
-> Ord InteractionDataComponent
InteractionDataComponent -> InteractionDataComponent -> Bool
InteractionDataComponent -> InteractionDataComponent -> Ordering
InteractionDataComponent
-> InteractionDataComponent -> InteractionDataComponent
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 :: InteractionDataComponent
-> InteractionDataComponent -> InteractionDataComponent
$cmin :: InteractionDataComponent
-> InteractionDataComponent -> InteractionDataComponent
max :: InteractionDataComponent
-> InteractionDataComponent -> InteractionDataComponent
$cmax :: InteractionDataComponent
-> InteractionDataComponent -> InteractionDataComponent
>= :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c>= :: InteractionDataComponent -> InteractionDataComponent -> Bool
> :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c> :: InteractionDataComponent -> InteractionDataComponent -> Bool
<= :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c<= :: InteractionDataComponent -> InteractionDataComponent -> Bool
< :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c< :: InteractionDataComponent -> InteractionDataComponent -> Bool
compare :: InteractionDataComponent -> InteractionDataComponent -> Ordering
$ccompare :: InteractionDataComponent -> InteractionDataComponent -> Ordering
$cp1Ord :: Eq InteractionDataComponent
Ord)

instance FromJSON InteractionDataComponent where
  parseJSON :: Value -> Parser InteractionDataComponent
parseJSON =
    String
-> (Object -> Parser InteractionDataComponent)
-> Value
-> Parser InteractionDataComponent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InteractionDataComponent"
      ( \Object
v -> do
          InteractionToken
cid <- Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"component_type" :: Parser Int
          case Int
t of
            Int
2 -> InteractionDataComponent -> Parser InteractionDataComponent
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataComponent -> Parser InteractionDataComponent)
-> InteractionDataComponent -> Parser InteractionDataComponent
forall a b. (a -> b) -> a -> b
$ InteractionToken -> InteractionDataComponent
InteractionDataComponentButton InteractionToken
cid
            Int
3 ->
              InteractionToken -> [InteractionToken] -> InteractionDataComponent
InteractionDataComponentSelectMenu InteractionToken
cid
                ([InteractionToken] -> InteractionDataComponent)
-> Parser [InteractionToken] -> Parser InteractionDataComponent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [InteractionToken]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"values"
            Int
_ -> String -> Parser InteractionDataComponent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown interaction data component type"
      )

data InteractionDataApplicationCommand
  = InteractionDataApplicationCommandUser
      { -- | Id of the invoked command.
        InteractionDataApplicationCommand -> InteractionId
interactionDataApplicationCommandId :: ApplicationCommandId,
        -- | Name of the invoked command.
        InteractionDataApplicationCommand -> InteractionToken
interactionDataApplicationCommandName :: T.Text,
        -- | The resolved data in the command.
        InteractionDataApplicationCommand -> Maybe ResolvedData
interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,
        -- | The id of the user that is the target.
        InteractionDataApplicationCommand -> InteractionId
interactionDataApplicationCommandTargetId :: UserId
      }
  | InteractionDataApplicationCommandMessage
      { -- | Id of the invoked command.
        interactionDataApplicationCommandId :: ApplicationCommandId,
        -- | Name of the invoked command.
        interactionDataApplicationCommandName :: T.Text,
        -- | The resolved data in the command.
        interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,
        -- | The id of the message that is the target.
        interactionDataApplicationCommandTargetId :: MessageId
      }
  | InteractionDataApplicationCommandChatInput
      { -- | Id of the invoked command.
        interactionDataApplicationCommandId :: ApplicationCommandId,
        -- | Name of the invoked command.
        interactionDataApplicationCommandName :: T.Text,
        -- | The resolved data in the command.
        interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,
        -- | The options of the application command.
        InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommandOptions
interactionDataApplicationCommandOptions :: Maybe InteractionDataApplicationCommandOptions
      }
  deriving (Int -> InteractionDataApplicationCommand -> ShowS
[InteractionDataApplicationCommand] -> ShowS
InteractionDataApplicationCommand -> String
(Int -> InteractionDataApplicationCommand -> ShowS)
-> (InteractionDataApplicationCommand -> String)
-> ([InteractionDataApplicationCommand] -> ShowS)
-> Show InteractionDataApplicationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommand] -> ShowS
$cshowList :: [InteractionDataApplicationCommand] -> ShowS
show :: InteractionDataApplicationCommand -> String
$cshow :: InteractionDataApplicationCommand -> String
showsPrec :: Int -> InteractionDataApplicationCommand -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommand -> ShowS
Show, ReadPrec [InteractionDataApplicationCommand]
ReadPrec InteractionDataApplicationCommand
Int -> ReadS InteractionDataApplicationCommand
ReadS [InteractionDataApplicationCommand]
(Int -> ReadS InteractionDataApplicationCommand)
-> ReadS [InteractionDataApplicationCommand]
-> ReadPrec InteractionDataApplicationCommand
-> ReadPrec [InteractionDataApplicationCommand]
-> Read InteractionDataApplicationCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommand]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommand]
readPrec :: ReadPrec InteractionDataApplicationCommand
$creadPrec :: ReadPrec InteractionDataApplicationCommand
readList :: ReadS [InteractionDataApplicationCommand]
$creadList :: ReadS [InteractionDataApplicationCommand]
readsPrec :: Int -> ReadS InteractionDataApplicationCommand
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommand
Read, InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
(InteractionDataApplicationCommand
 -> InteractionDataApplicationCommand -> Bool)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand -> Bool)
-> Eq InteractionDataApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c/= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
== :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c== :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
Eq, Eq InteractionDataApplicationCommand
Eq InteractionDataApplicationCommand
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand -> Ordering)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand -> Bool)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand -> Bool)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand -> Bool)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand -> Bool)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand)
-> Ord InteractionDataApplicationCommand
InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Ordering
InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
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 :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
$cmin :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
max :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
$cmax :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
-> InteractionDataApplicationCommand
>= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c>= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
> :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c> :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
<= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c<= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
< :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c< :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
compare :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Ordering
$ccompare :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Ordering
$cp1Ord :: Eq InteractionDataApplicationCommand
Ord)

instance FromJSON InteractionDataApplicationCommand where
  parseJSON :: Value -> Parser InteractionDataApplicationCommand
parseJSON =
    String
-> (Object -> Parser InteractionDataApplicationCommand)
-> Value
-> Parser InteractionDataApplicationCommand
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InteractionDataApplicationCommand"
      ( \Object
v -> do
          InteractionId
aci <- Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          InteractionToken
name <- Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Maybe ResolvedData
rd <- Object
v Object -> Key -> Parser (Maybe ResolvedData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resolved_data"
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 ->
              InteractionId
-> InteractionToken
-> Maybe ResolvedData
-> Maybe InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommand
InteractionDataApplicationCommandChatInput InteractionId
aci InteractionToken
name Maybe ResolvedData
rd
                (Maybe InteractionDataApplicationCommandOptions
 -> InteractionDataApplicationCommand)
-> Parser (Maybe InteractionDataApplicationCommandOptions)
-> Parser InteractionDataApplicationCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object
-> Key -> Parser (Maybe InteractionDataApplicationCommandOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
            Int
2 ->
              InteractionId
-> InteractionToken
-> Maybe ResolvedData
-> InteractionId
-> InteractionDataApplicationCommand
InteractionDataApplicationCommandUser InteractionId
aci InteractionToken
name Maybe ResolvedData
rd
                (InteractionId -> InteractionDataApplicationCommand)
-> Parser InteractionId -> Parser InteractionDataApplicationCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_id"
            Int
3 ->
              InteractionId
-> InteractionToken
-> Maybe ResolvedData
-> InteractionId
-> InteractionDataApplicationCommand
InteractionDataApplicationCommandMessage InteractionId
aci InteractionToken
name Maybe ResolvedData
rd
                (InteractionId -> InteractionDataApplicationCommand)
-> Parser InteractionId -> Parser InteractionDataApplicationCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_id"
            Int
_ -> String -> Parser InteractionDataApplicationCommand
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown interaction data component type"
      )

-- | Either subcommands and groups, or values.
data InteractionDataApplicationCommandOptions
  = InteractionDataApplicationCommandOptionsSubcommands [InteractionDataApplicationCommandOptionSubcommandOrGroup]
  | InteractionDataApplicationCommandOptionsValues [InteractionDataApplicationCommandOptionValue]
  deriving (Int -> InteractionDataApplicationCommandOptions -> ShowS
[InteractionDataApplicationCommandOptions] -> ShowS
InteractionDataApplicationCommandOptions -> String
(Int -> InteractionDataApplicationCommandOptions -> ShowS)
-> (InteractionDataApplicationCommandOptions -> String)
-> ([InteractionDataApplicationCommandOptions] -> ShowS)
-> Show InteractionDataApplicationCommandOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptions] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptions] -> ShowS
show :: InteractionDataApplicationCommandOptions -> String
$cshow :: InteractionDataApplicationCommandOptions -> String
showsPrec :: Int -> InteractionDataApplicationCommandOptions -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommandOptions -> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptions]
ReadPrec InteractionDataApplicationCommandOptions
Int -> ReadS InteractionDataApplicationCommandOptions
ReadS [InteractionDataApplicationCommandOptions]
(Int -> ReadS InteractionDataApplicationCommandOptions)
-> ReadS [InteractionDataApplicationCommandOptions]
-> ReadPrec InteractionDataApplicationCommandOptions
-> ReadPrec [InteractionDataApplicationCommandOptions]
-> Read InteractionDataApplicationCommandOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptions]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptions]
readPrec :: ReadPrec InteractionDataApplicationCommandOptions
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptions
readList :: ReadS [InteractionDataApplicationCommandOptions]
$creadList :: ReadS [InteractionDataApplicationCommandOptions]
readsPrec :: Int -> ReadS InteractionDataApplicationCommandOptions
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommandOptions
Read, InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
(InteractionDataApplicationCommandOptions
 -> InteractionDataApplicationCommandOptions -> Bool)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions -> Bool)
-> Eq InteractionDataApplicationCommandOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c/= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
== :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c== :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
Eq, Eq InteractionDataApplicationCommandOptions
Eq InteractionDataApplicationCommandOptions
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions -> Ordering)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions -> Bool)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions -> Bool)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions -> Bool)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions -> Bool)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions)
-> Ord InteractionDataApplicationCommandOptions
InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Ordering
InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
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 :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
$cmin :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
max :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
$cmax :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions
>= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c>= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
> :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c> :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
<= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c<= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
< :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c< :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
compare :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Ordering
$ccompare :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Ordering
$cp1Ord :: Eq InteractionDataApplicationCommandOptions
Ord)

instance FromJSON InteractionDataApplicationCommandOptions where
  parseJSON :: Value -> Parser InteractionDataApplicationCommandOptions
parseJSON =
    String
-> (Array -> Parser InteractionDataApplicationCommandOptions)
-> Value
-> Parser InteractionDataApplicationCommandOptions
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray
      String
"InteractionDataApplicationCommandOptions"
      ( \Array
a -> do
          let a' :: [Value]
a' = Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
          case [Value]
a' of
            [] -> InteractionDataApplicationCommandOptions
-> Parser InteractionDataApplicationCommandOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataApplicationCommandOptions
 -> Parser InteractionDataApplicationCommandOptions)
-> InteractionDataApplicationCommandOptions
-> Parser InteractionDataApplicationCommandOptions
forall a b. (a -> b) -> a -> b
$ [InteractionDataApplicationCommandOptionValue]
-> InteractionDataApplicationCommandOptions
InteractionDataApplicationCommandOptionsValues []
            (Value
v' : [Value]
_) ->
              String
-> (Object -> Parser InteractionDataApplicationCommandOptions)
-> Value
-> Parser InteractionDataApplicationCommandOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
                String
"InteractionDataApplicationCommandOptions item"
                ( \Object
v -> do
                    Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
                    if Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                      then [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> InteractionDataApplicationCommandOptions
InteractionDataApplicationCommandOptionsSubcommands ([InteractionDataApplicationCommandOptionSubcommandOrGroup]
 -> InteractionDataApplicationCommandOptions)
-> Parser
     [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> Parser InteractionDataApplicationCommandOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
 -> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> [Value]
-> Parser
     [InteractionDataApplicationCommandOptionSubcommandOrGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value
-> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                      else [InteractionDataApplicationCommandOptionValue]
-> InteractionDataApplicationCommandOptions
InteractionDataApplicationCommandOptionsValues ([InteractionDataApplicationCommandOptionValue]
 -> InteractionDataApplicationCommandOptions)
-> Parser [InteractionDataApplicationCommandOptionValue]
-> Parser InteractionDataApplicationCommandOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser InteractionDataApplicationCommandOptionValue)
-> [Value] -> Parser [InteractionDataApplicationCommandOptionValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser InteractionDataApplicationCommandOptionValue
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                )
                Value
v'
      )

-- | Either a subcommand group or a subcommand.
data InteractionDataApplicationCommandOptionSubcommandOrGroup
  = InteractionDataApplicationCommandOptionSubcommandGroup
      { InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionToken
interactionDataApplicationCommandOptionSubcommandGroupName :: T.Text,
        InteractionDataApplicationCommandOptionSubcommandOrGroup
-> [InteractionDataApplicationCommandOptionSubcommand]
interactionDataApplicationCommandOptionSubcommandGroupOptions :: [InteractionDataApplicationCommandOptionSubcommand],
        InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
interactionDataApplicationCommandOptionSubcommandGroupFocused :: Bool
      }
  | InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand InteractionDataApplicationCommandOptionSubcommand
  deriving (Int
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ShowS
[InteractionDataApplicationCommandOptionSubcommandOrGroup] -> ShowS
InteractionDataApplicationCommandOptionSubcommandOrGroup -> String
(Int
 -> InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> ShowS)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> String)
-> ([InteractionDataApplicationCommandOptionSubcommandOrGroup]
    -> ShowS)
-> Show InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptionSubcommandOrGroup] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptionSubcommandOrGroup] -> ShowS
show :: InteractionDataApplicationCommandOptionSubcommandOrGroup -> String
$cshow :: InteractionDataApplicationCommandOptionSubcommandOrGroup -> String
showsPrec :: Int
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ShowS
$cshowsPrec :: Int
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptionSubcommandOrGroup]
ReadPrec InteractionDataApplicationCommandOptionSubcommandOrGroup
Int
-> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup
ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
(Int
 -> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> ReadPrec
     InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ReadPrec
     [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> Read InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommandOrGroup]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommandOrGroup]
readPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommandOrGroup
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommandOrGroup
readList :: ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
$creadList :: ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
readsPrec :: Int
-> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup
$creadsPrec :: Int
-> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup
Read, InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
(InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> Bool)
-> Eq InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c/= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
== :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c== :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
Eq, Eq InteractionDataApplicationCommandOptionSubcommandOrGroup
Eq InteractionDataApplicationCommandOptionSubcommandOrGroup
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> Ordering)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> Ord InteractionDataApplicationCommandOptionSubcommandOrGroup
InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> Ordering
InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
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 :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
$cmin :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
max :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
$cmax :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
>= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c>= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
> :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c> :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
<= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c<= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
< :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c< :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
compare :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> Ordering
$ccompare :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> Ordering
$cp1Ord :: Eq InteractionDataApplicationCommandOptionSubcommandOrGroup
Ord)

instance FromJSON InteractionDataApplicationCommandOptionSubcommandOrGroup where
  parseJSON :: Value
-> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup
parseJSON =
    String
-> (Object
    -> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> Value
-> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InteractionDataApplicationCommandOptionSubcommandOrGroup"
      ( \Object
v -> do
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
2 ->
              InteractionToken
-> [InteractionDataApplicationCommandOptionSubcommand]
-> Bool
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
InteractionDataApplicationCommandOptionSubcommandGroup
                (InteractionToken
 -> [InteractionDataApplicationCommandOptionSubcommand]
 -> Bool
 -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> Parser InteractionToken
-> Parser
     ([InteractionDataApplicationCommandOptionSubcommand]
      -> Bool
      -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Parser
  ([InteractionDataApplicationCommandOptionSubcommand]
   -> Bool
   -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> Parser [InteractionDataApplicationCommandOptionSubcommand]
-> Parser
     (Bool -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object
-> Key
-> Parser [InteractionDataApplicationCommandOptionSubcommand]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"options"
                Parser
  (Bool -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> Parser Bool
-> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Int
1 -> InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand (InteractionDataApplicationCommandOptionSubcommand
 -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> Parser InteractionDataApplicationCommandOptionSubcommand
-> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InteractionDataApplicationCommandOptionSubcommand
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Int
_ -> String
-> Parser InteractionDataApplicationCommandOptionSubcommandOrGroup
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected subcommand group type"
      )

-- | Data for a single subcommand.
data InteractionDataApplicationCommandOptionSubcommand = InteractionDataApplicationCommandOptionSubcommand
  { InteractionDataApplicationCommandOptionSubcommand
-> InteractionToken
interactionDataApplicationCommandOptionSubcommandName :: T.Text,
    InteractionDataApplicationCommandOptionSubcommand
-> [InteractionDataApplicationCommandOptionValue]
interactionDataApplicationCommandOptionSubcommandOptions :: [InteractionDataApplicationCommandOptionValue],
    InteractionDataApplicationCommandOptionSubcommand -> Bool
interactionDataApplicationCommandOptionSubcommandFocused :: Bool
  }
  deriving (Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS
[InteractionDataApplicationCommandOptionSubcommand] -> ShowS
InteractionDataApplicationCommandOptionSubcommand -> String
(Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS)
-> (InteractionDataApplicationCommandOptionSubcommand -> String)
-> ([InteractionDataApplicationCommandOptionSubcommand] -> ShowS)
-> Show InteractionDataApplicationCommandOptionSubcommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptionSubcommand] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptionSubcommand] -> ShowS
show :: InteractionDataApplicationCommandOptionSubcommand -> String
$cshow :: InteractionDataApplicationCommandOptionSubcommand -> String
showsPrec :: Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
ReadPrec InteractionDataApplicationCommandOptionSubcommand
Int -> ReadS InteractionDataApplicationCommandOptionSubcommand
ReadS [InteractionDataApplicationCommandOptionSubcommand]
(Int -> ReadS InteractionDataApplicationCommandOptionSubcommand)
-> ReadS [InteractionDataApplicationCommandOptionSubcommand]
-> ReadPrec InteractionDataApplicationCommandOptionSubcommand
-> ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
-> Read InteractionDataApplicationCommandOptionSubcommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
readPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommand
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommand
readList :: ReadS [InteractionDataApplicationCommandOptionSubcommand]
$creadList :: ReadS [InteractionDataApplicationCommandOptionSubcommand]
readsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionSubcommand
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionSubcommand
Read, InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
(InteractionDataApplicationCommandOptionSubcommand
 -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> Eq InteractionDataApplicationCommandOptionSubcommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c/= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
== :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c== :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
Eq, Eq InteractionDataApplicationCommandOptionSubcommand
Eq InteractionDataApplicationCommandOptionSubcommand
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand -> Ordering)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand)
-> Ord InteractionDataApplicationCommandOptionSubcommand
InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Ordering
InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
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 :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
$cmin :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
max :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
$cmax :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand
>= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c>= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
> :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c> :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
<= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c<= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
< :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c< :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
compare :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Ordering
$ccompare :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Ordering
$cp1Ord :: Eq InteractionDataApplicationCommandOptionSubcommand
Ord)

instance FromJSON InteractionDataApplicationCommandOptionSubcommand where
  parseJSON :: Value -> Parser InteractionDataApplicationCommandOptionSubcommand
parseJSON =
    String
-> (Object
    -> Parser InteractionDataApplicationCommandOptionSubcommand)
-> Value
-> Parser InteractionDataApplicationCommandOptionSubcommand
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InteractionDataApplicationCommandOptionSubcommand"
      ( \Object
v -> do
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 ->
              InteractionToken
-> [InteractionDataApplicationCommandOptionValue]
-> Bool
-> InteractionDataApplicationCommandOptionSubcommand
InteractionDataApplicationCommandOptionSubcommand
                (InteractionToken
 -> [InteractionDataApplicationCommandOptionValue]
 -> Bool
 -> InteractionDataApplicationCommandOptionSubcommand)
-> Parser InteractionToken
-> Parser
     ([InteractionDataApplicationCommandOptionValue]
      -> Bool -> InteractionDataApplicationCommandOptionSubcommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Parser
  ([InteractionDataApplicationCommandOptionValue]
   -> Bool -> InteractionDataApplicationCommandOptionSubcommand)
-> Parser [InteractionDataApplicationCommandOptionValue]
-> Parser
     (Bool -> InteractionDataApplicationCommandOptionSubcommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object
-> Key
-> Parser (Maybe [InteractionDataApplicationCommandOptionValue])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options" Parser (Maybe [InteractionDataApplicationCommandOptionValue])
-> [InteractionDataApplicationCommandOptionValue]
-> Parser [InteractionDataApplicationCommandOptionValue]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                Parser (Bool -> InteractionDataApplicationCommandOptionSubcommand)
-> Parser Bool
-> Parser InteractionDataApplicationCommandOptionSubcommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Int
_ -> String -> Parser InteractionDataApplicationCommandOptionSubcommand
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected subcommand type"
      )

-- | Data for a single value.
data InteractionDataApplicationCommandOptionValue
  = InteractionDataApplicationCommandOptionValueString
      { InteractionDataApplicationCommandOptionValue -> InteractionToken
interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue
-> Either InteractionToken InteractionToken
interactionDataApplicationCommandOptionValueStringValue :: Either T.Text T.Text
      }
  | InteractionDataApplicationCommandOptionValueInteger
      { interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue
-> Either InteractionToken Integer
interactionDataApplicationCommandOptionValueIntegerValue :: Either T.Text Integer
      }
  | InteractionDataApplicationCommandOptionValueBoolean
      { interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue -> Bool
interactionDataApplicationCommandOptionValueBooleanValue :: Bool
      }
  | InteractionDataApplicationCommandOptionValueUser
      { interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue -> InteractionId
interactionDataApplicationCommandOptionValueUserValue :: UserId
      }
  | InteractionDataApplicationCommandOptionValueChannel
      { interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue -> InteractionId
interactionDataApplicationCommandOptionValueChannelValue :: ChannelId
      }
  | InteractionDataApplicationCommandOptionValueRole
      { interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue -> InteractionId
interactionDataApplicationCommandOptionValueRoleValue :: RoleId
      }
  | InteractionDataApplicationCommandOptionValueMentionable
      { interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue -> InteractionId
interactionDataApplicationCommandOptionValueMentionableValue :: Snowflake
      }
  | InteractionDataApplicationCommandOptionValueNumber
      { interactionDataApplicationCommandOptionValueName :: T.Text,
        InteractionDataApplicationCommandOptionValue
-> Either InteractionToken Scientific
interactionDataApplicationCommandOptionValueNumberValue :: Either T.Text Scientific
      }
  deriving (Int -> InteractionDataApplicationCommandOptionValue -> ShowS
[InteractionDataApplicationCommandOptionValue] -> ShowS
InteractionDataApplicationCommandOptionValue -> String
(Int -> InteractionDataApplicationCommandOptionValue -> ShowS)
-> (InteractionDataApplicationCommandOptionValue -> String)
-> ([InteractionDataApplicationCommandOptionValue] -> ShowS)
-> Show InteractionDataApplicationCommandOptionValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptionValue] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptionValue] -> ShowS
show :: InteractionDataApplicationCommandOptionValue -> String
$cshow :: InteractionDataApplicationCommandOptionValue -> String
showsPrec :: Int -> InteractionDataApplicationCommandOptionValue -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommandOptionValue -> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptionValue]
ReadPrec InteractionDataApplicationCommandOptionValue
Int -> ReadS InteractionDataApplicationCommandOptionValue
ReadS [InteractionDataApplicationCommandOptionValue]
(Int -> ReadS InteractionDataApplicationCommandOptionValue)
-> ReadS [InteractionDataApplicationCommandOptionValue]
-> ReadPrec InteractionDataApplicationCommandOptionValue
-> ReadPrec [InteractionDataApplicationCommandOptionValue]
-> Read InteractionDataApplicationCommandOptionValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptionValue]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptionValue]
readPrec :: ReadPrec InteractionDataApplicationCommandOptionValue
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptionValue
readList :: ReadS [InteractionDataApplicationCommandOptionValue]
$creadList :: ReadS [InteractionDataApplicationCommandOptionValue]
readsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionValue
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionValue
Read, InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
(InteractionDataApplicationCommandOptionValue
 -> InteractionDataApplicationCommandOptionValue -> Bool)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue -> Bool)
-> Eq InteractionDataApplicationCommandOptionValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c/= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
== :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c== :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
Eq, Eq InteractionDataApplicationCommandOptionValue
Eq InteractionDataApplicationCommandOptionValue
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue -> Ordering)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue -> Bool)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue -> Bool)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue -> Bool)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue -> Bool)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue)
-> Ord InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Ordering
InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
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 :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
$cmin :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
max :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
$cmax :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue
>= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c>= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
> :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c> :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
<= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c<= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
< :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c< :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
compare :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Ordering
$ccompare :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Ordering
$cp1Ord :: Eq InteractionDataApplicationCommandOptionValue
Ord)

instance FromJSON InteractionDataApplicationCommandOptionValue where
  parseJSON :: Value -> Parser InteractionDataApplicationCommandOptionValue
parseJSON =
    String
-> (Object -> Parser InteractionDataApplicationCommandOptionValue)
-> Value
-> Parser InteractionDataApplicationCommandOptionValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InteractionDataApplicationCommandOptionValue"
      ( \Object
v -> do
          InteractionToken
name <- Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Bool
focused <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
3 ->
              InteractionToken
-> Either InteractionToken InteractionToken
-> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueString InteractionToken
name
                (Either InteractionToken InteractionToken
 -> InteractionDataApplicationCommandOptionValue)
-> Parser (Either InteractionToken InteractionToken)
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either InteractionToken InteractionToken)
forall a.
FromJSON a =>
Object -> Bool -> Parser (Either InteractionToken a)
parseValue Object
v Bool
focused
            Int
4 ->
              InteractionToken
-> Either InteractionToken Integer
-> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueInteger InteractionToken
name
                (Either InteractionToken Integer
 -> InteractionDataApplicationCommandOptionValue)
-> Parser (Either InteractionToken Integer)
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either InteractionToken Integer)
forall a.
FromJSON a =>
Object -> Bool -> Parser (Either InteractionToken a)
parseValue Object
v Bool
focused
            Int
10 ->
              InteractionToken
-> Either InteractionToken Scientific
-> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueNumber InteractionToken
name
                (Either InteractionToken Scientific
 -> InteractionDataApplicationCommandOptionValue)
-> Parser (Either InteractionToken Scientific)
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either InteractionToken Scientific)
forall a.
FromJSON a =>
Object -> Bool -> Parser (Either InteractionToken a)
parseValue Object
v Bool
focused
            Int
5 ->
              InteractionToken
-> Bool -> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueBoolean InteractionToken
name
                (Bool -> InteractionDataApplicationCommandOptionValue)
-> Parser Bool
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
6 ->
              InteractionToken
-> InteractionId -> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueUser InteractionToken
name
                (InteractionId -> InteractionDataApplicationCommandOptionValue)
-> Parser InteractionId
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
7 ->
              InteractionToken
-> InteractionId -> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueChannel InteractionToken
name
                (InteractionId -> InteractionDataApplicationCommandOptionValue)
-> Parser InteractionId
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
8 ->
              InteractionToken
-> InteractionId -> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueRole InteractionToken
name
                (InteractionId -> InteractionDataApplicationCommandOptionValue)
-> Parser InteractionId
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
9 ->
              InteractionToken
-> InteractionId -> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValueMentionable InteractionToken
name
                (InteractionId -> InteractionDataApplicationCommandOptionValue)
-> Parser InteractionId
-> Parser InteractionDataApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
_ -> String -> Parser InteractionDataApplicationCommandOptionValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser InteractionDataApplicationCommandOptionValue)
-> String -> Parser InteractionDataApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ String
"unexpected interaction data application command option value type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t
      )

data InteractionDataModal = InteractionDataModal
  { -- | The unique id of the component (up to 100 characters).
    InteractionDataModal -> InteractionToken
interactionDataModalCustomId :: T.Text,
    -- | Components from the modal.
    InteractionDataModal -> [ComponentTextInput]
interactionDataModalComponents :: [ComponentTextInput]
  }
  deriving (Int -> InteractionDataModal -> ShowS
[InteractionDataModal] -> ShowS
InteractionDataModal -> String
(Int -> InteractionDataModal -> ShowS)
-> (InteractionDataModal -> String)
-> ([InteractionDataModal] -> ShowS)
-> Show InteractionDataModal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataModal] -> ShowS
$cshowList :: [InteractionDataModal] -> ShowS
show :: InteractionDataModal -> String
$cshow :: InteractionDataModal -> String
showsPrec :: Int -> InteractionDataModal -> ShowS
$cshowsPrec :: Int -> InteractionDataModal -> ShowS
Show, ReadPrec [InteractionDataModal]
ReadPrec InteractionDataModal
Int -> ReadS InteractionDataModal
ReadS [InteractionDataModal]
(Int -> ReadS InteractionDataModal)
-> ReadS [InteractionDataModal]
-> ReadPrec InteractionDataModal
-> ReadPrec [InteractionDataModal]
-> Read InteractionDataModal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataModal]
$creadListPrec :: ReadPrec [InteractionDataModal]
readPrec :: ReadPrec InteractionDataModal
$creadPrec :: ReadPrec InteractionDataModal
readList :: ReadS [InteractionDataModal]
$creadList :: ReadS [InteractionDataModal]
readsPrec :: Int -> ReadS InteractionDataModal
$creadsPrec :: Int -> ReadS InteractionDataModal
Read, InteractionDataModal -> InteractionDataModal -> Bool
(InteractionDataModal -> InteractionDataModal -> Bool)
-> (InteractionDataModal -> InteractionDataModal -> Bool)
-> Eq InteractionDataModal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataModal -> InteractionDataModal -> Bool
$c/= :: InteractionDataModal -> InteractionDataModal -> Bool
== :: InteractionDataModal -> InteractionDataModal -> Bool
$c== :: InteractionDataModal -> InteractionDataModal -> Bool
Eq, Eq InteractionDataModal
Eq InteractionDataModal
-> (InteractionDataModal -> InteractionDataModal -> Ordering)
-> (InteractionDataModal -> InteractionDataModal -> Bool)
-> (InteractionDataModal -> InteractionDataModal -> Bool)
-> (InteractionDataModal -> InteractionDataModal -> Bool)
-> (InteractionDataModal -> InteractionDataModal -> Bool)
-> (InteractionDataModal
    -> InteractionDataModal -> InteractionDataModal)
-> (InteractionDataModal
    -> InteractionDataModal -> InteractionDataModal)
-> Ord InteractionDataModal
InteractionDataModal -> InteractionDataModal -> Bool
InteractionDataModal -> InteractionDataModal -> Ordering
InteractionDataModal
-> InteractionDataModal -> InteractionDataModal
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 :: InteractionDataModal
-> InteractionDataModal -> InteractionDataModal
$cmin :: InteractionDataModal
-> InteractionDataModal -> InteractionDataModal
max :: InteractionDataModal
-> InteractionDataModal -> InteractionDataModal
$cmax :: InteractionDataModal
-> InteractionDataModal -> InteractionDataModal
>= :: InteractionDataModal -> InteractionDataModal -> Bool
$c>= :: InteractionDataModal -> InteractionDataModal -> Bool
> :: InteractionDataModal -> InteractionDataModal -> Bool
$c> :: InteractionDataModal -> InteractionDataModal -> Bool
<= :: InteractionDataModal -> InteractionDataModal -> Bool
$c<= :: InteractionDataModal -> InteractionDataModal -> Bool
< :: InteractionDataModal -> InteractionDataModal -> Bool
$c< :: InteractionDataModal -> InteractionDataModal -> Bool
compare :: InteractionDataModal -> InteractionDataModal -> Ordering
$ccompare :: InteractionDataModal -> InteractionDataModal -> Ordering
$cp1Ord :: Eq InteractionDataModal
Ord)

instance FromJSON InteractionDataModal where
  parseJSON :: Value -> Parser InteractionDataModal
parseJSON =
    String
-> (Object -> Parser InteractionDataModal)
-> Value
-> Parser InteractionDataModal
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InteractionDataModal"
      ( \Object
v ->
          InteractionToken -> [ComponentTextInput] -> InteractionDataModal
InteractionDataModal (InteractionToken -> [ComponentTextInput] -> InteractionDataModal)
-> Parser InteractionToken
-> Parser ([ComponentTextInput] -> InteractionDataModal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"
            Parser ([ComponentTextInput] -> InteractionDataModal)
-> Parser [ComponentTextInput] -> Parser InteractionDataModal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
v Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components") Parser [Value]
-> ([Value] -> Parser [ComponentTextInput])
-> Parser [ComponentTextInput]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([[ComponentTextInput]] -> [ComponentTextInput]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[ComponentTextInput]] -> [ComponentTextInput])
-> Parser [[ComponentTextInput]] -> Parser [ComponentTextInput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser [[ComponentTextInput]] -> Parser [ComponentTextInput])
-> ([Value] -> Parser [[ComponentTextInput]])
-> [Value]
-> Parser [ComponentTextInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser [ComponentTextInput])
-> [Value] -> Parser [[ComponentTextInput]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser [ComponentTextInput]
getTextInput)
      )
    where
      getTextInput :: Value -> Parser [ComponentTextInput]
      getTextInput :: Value -> Parser [ComponentTextInput]
getTextInput = String
-> (Object -> Parser [ComponentTextInput])
-> Value
-> Parser [ComponentTextInput]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InteractionDataModal.TextInput" ((Object -> Parser [ComponentTextInput])
 -> Value -> Parser [ComponentTextInput])
-> (Object -> Parser [ComponentTextInput])
-> Value
-> Parser [ComponentTextInput]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Int
t <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
        case Int
t of
          Int
1 -> Object
o Object -> Key -> Parser [ComponentTextInput]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components"
          Int
_ -> String -> Parser [ComponentTextInput]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser [ComponentTextInput])
-> String -> Parser [ComponentTextInput]
forall a b. (a -> b) -> a -> b
$ String
"expected action row type (1), got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t

parseValue :: (FromJSON a) => Object -> Bool -> Parser (Either T.Text a)
parseValue :: Object -> Bool -> Parser (Either InteractionToken a)
parseValue Object
o Bool
True = InteractionToken -> Either InteractionToken a
forall a b. a -> Either a b
Left (InteractionToken -> Either InteractionToken a)
-> Parser InteractionToken -> Parser (Either InteractionToken a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
parseValue Object
o Bool
False = a -> Either InteractionToken a
forall a b. b -> Either a b
Right (a -> Either InteractionToken a)
-> Parser a -> Parser (Either InteractionToken a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"

-- resolved data -- this should be formalised and integrated, instead of being
--  left as values

-- | I'm not sure what this stuff is, so you're on your own.
--
-- It's not worth the time working out how to create this stuff.
-- If you need to extract from these values, check out the link below.
--
-- https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-resolved-data-structure
data ResolvedData = ResolvedData
  { ResolvedData -> Maybe Value
resolvedDataUsers :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataMembers :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataRoles :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataChannels :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataMessages :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataAttachments :: Maybe Value
  }
  deriving (Int -> ResolvedData -> ShowS
[ResolvedData] -> ShowS
ResolvedData -> String
(Int -> ResolvedData -> ShowS)
-> (ResolvedData -> String)
-> ([ResolvedData] -> ShowS)
-> Show ResolvedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedData] -> ShowS
$cshowList :: [ResolvedData] -> ShowS
show :: ResolvedData -> String
$cshow :: ResolvedData -> String
showsPrec :: Int -> ResolvedData -> ShowS
$cshowsPrec :: Int -> ResolvedData -> ShowS
Show, ReadPrec [ResolvedData]
ReadPrec ResolvedData
Int -> ReadS ResolvedData
ReadS [ResolvedData]
(Int -> ReadS ResolvedData)
-> ReadS [ResolvedData]
-> ReadPrec ResolvedData
-> ReadPrec [ResolvedData]
-> Read ResolvedData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResolvedData]
$creadListPrec :: ReadPrec [ResolvedData]
readPrec :: ReadPrec ResolvedData
$creadPrec :: ReadPrec ResolvedData
readList :: ReadS [ResolvedData]
$creadList :: ReadS [ResolvedData]
readsPrec :: Int -> ReadS ResolvedData
$creadsPrec :: Int -> ReadS ResolvedData
Read, ResolvedData -> ResolvedData -> Bool
(ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool) -> Eq ResolvedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvedData -> ResolvedData -> Bool
$c/= :: ResolvedData -> ResolvedData -> Bool
== :: ResolvedData -> ResolvedData -> Bool
$c== :: ResolvedData -> ResolvedData -> Bool
Eq, Eq ResolvedData
Eq ResolvedData
-> (ResolvedData -> ResolvedData -> Ordering)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> ResolvedData)
-> (ResolvedData -> ResolvedData -> ResolvedData)
-> Ord ResolvedData
ResolvedData -> ResolvedData -> Bool
ResolvedData -> ResolvedData -> Ordering
ResolvedData -> ResolvedData -> ResolvedData
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 :: ResolvedData -> ResolvedData -> ResolvedData
$cmin :: ResolvedData -> ResolvedData -> ResolvedData
max :: ResolvedData -> ResolvedData -> ResolvedData
$cmax :: ResolvedData -> ResolvedData -> ResolvedData
>= :: ResolvedData -> ResolvedData -> Bool
$c>= :: ResolvedData -> ResolvedData -> Bool
> :: ResolvedData -> ResolvedData -> Bool
$c> :: ResolvedData -> ResolvedData -> Bool
<= :: ResolvedData -> ResolvedData -> Bool
$c<= :: ResolvedData -> ResolvedData -> Bool
< :: ResolvedData -> ResolvedData -> Bool
$c< :: ResolvedData -> ResolvedData -> Bool
compare :: ResolvedData -> ResolvedData -> Ordering
$ccompare :: ResolvedData -> ResolvedData -> Ordering
$cp1Ord :: Eq ResolvedData
Ord)

instance ToJSON ResolvedData where
  toJSON :: ResolvedData -> Value
toJSON ResolvedData {Maybe Value
resolvedDataAttachments :: Maybe Value
resolvedDataMessages :: Maybe Value
resolvedDataChannels :: Maybe Value
resolvedDataRoles :: Maybe Value
resolvedDataMembers :: Maybe Value
resolvedDataUsers :: Maybe Value
resolvedDataAttachments :: ResolvedData -> Maybe Value
resolvedDataMessages :: ResolvedData -> Maybe Value
resolvedDataChannels :: ResolvedData -> Maybe Value
resolvedDataRoles :: ResolvedData -> Maybe Value
resolvedDataMembers :: ResolvedData -> Maybe Value
resolvedDataUsers :: ResolvedData -> Maybe Value
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"users", Maybe Value
resolvedDataUsers),
              (Key
"members", Maybe Value
resolvedDataMembers),
              (Key
"roles", Maybe Value
resolvedDataRoles),
              (Key
"channels", Maybe Value
resolvedDataChannels),
              (Key
"messages", Maybe Value
resolvedDataMessages),
              (Key
"attachments", Maybe Value
resolvedDataAttachments)
            ]
      ]

instance FromJSON ResolvedData where
  parseJSON :: Value -> Parser ResolvedData
parseJSON =
    String
-> (Object -> Parser ResolvedData) -> Value -> Parser ResolvedData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ResolvedData"
      ( \Object
v ->
          Maybe Value
-> Maybe Value
-> Maybe Value
-> Maybe Value
-> Maybe Value
-> Maybe Value
-> ResolvedData
ResolvedData
            (Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> ResolvedData)
-> Parser (Maybe Value)
-> Parser
     (Maybe Value
      -> Maybe Value
      -> Maybe Value
      -> Maybe Value
      -> Maybe Value
      -> ResolvedData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"users"
            Parser
  (Maybe Value
   -> Maybe Value
   -> Maybe Value
   -> Maybe Value
   -> Maybe Value
   -> ResolvedData)
-> Parser (Maybe Value)
-> Parser
     (Maybe Value
      -> Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"members"
            Parser
  (Maybe Value
   -> Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
-> Parser (Maybe Value)
-> Parser
     (Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles"
            Parser (Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
-> Parser (Maybe Value)
-> Parser (Maybe Value -> Maybe Value -> ResolvedData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channels"
            Parser (Maybe Value -> Maybe Value -> ResolvedData)
-> Parser (Maybe Value) -> Parser (Maybe Value -> ResolvedData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"messages"
            Parser (Maybe Value -> ResolvedData)
-> Parser (Maybe Value) -> Parser ResolvedData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attachments"
      )

-- | The data to respond to an interaction with. Unless specified otherwise, you
-- only have three seconds to reply to an interaction before a failure state is
-- given.
data InteractionResponse
  = -- | ACK a Ping
    InteractionResponsePong
  | -- | Respond to an interaction with a message
    InteractionResponseChannelMessage InteractionResponseMessage
  | -- | ACK an interaction and edit a response later (use `CreateFollowupInteractionMessage` and `InteractionResponseMessage` to do so). User sees loading state.
    InteractionResponseDeferChannelMessage
  | -- | for components, ACK an interaction and edit the original message later; the user does not see a loading state.
    InteractionResponseDeferUpdateMessage
  | -- | for components, edit the message the component was attached to
    InteractionResponseUpdateMessage InteractionResponseMessage
  | -- | respond to an autocomplete interaction with suggested choices
    InteractionResponseAutocompleteResult InteractionResponseAutocomplete
  | -- | respond with a popup modal
    InteractionResponseModal InteractionResponseModalData
  deriving (Int -> InteractionResponse -> ShowS
[InteractionResponse] -> ShowS
InteractionResponse -> String
(Int -> InteractionResponse -> ShowS)
-> (InteractionResponse -> String)
-> ([InteractionResponse] -> ShowS)
-> Show InteractionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponse] -> ShowS
$cshowList :: [InteractionResponse] -> ShowS
show :: InteractionResponse -> String
$cshow :: InteractionResponse -> String
showsPrec :: Int -> InteractionResponse -> ShowS
$cshowsPrec :: Int -> InteractionResponse -> ShowS
Show, ReadPrec [InteractionResponse]
ReadPrec InteractionResponse
Int -> ReadS InteractionResponse
ReadS [InteractionResponse]
(Int -> ReadS InteractionResponse)
-> ReadS [InteractionResponse]
-> ReadPrec InteractionResponse
-> ReadPrec [InteractionResponse]
-> Read InteractionResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponse]
$creadListPrec :: ReadPrec [InteractionResponse]
readPrec :: ReadPrec InteractionResponse
$creadPrec :: ReadPrec InteractionResponse
readList :: ReadS [InteractionResponse]
$creadList :: ReadS [InteractionResponse]
readsPrec :: Int -> ReadS InteractionResponse
$creadsPrec :: Int -> ReadS InteractionResponse
Read, InteractionResponse -> InteractionResponse -> Bool
(InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> Eq InteractionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponse -> InteractionResponse -> Bool
$c/= :: InteractionResponse -> InteractionResponse -> Bool
== :: InteractionResponse -> InteractionResponse -> Bool
$c== :: InteractionResponse -> InteractionResponse -> Bool
Eq, Eq InteractionResponse
Eq InteractionResponse
-> (InteractionResponse -> InteractionResponse -> Ordering)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse
    -> InteractionResponse -> InteractionResponse)
-> (InteractionResponse
    -> InteractionResponse -> InteractionResponse)
-> Ord InteractionResponse
InteractionResponse -> InteractionResponse -> Bool
InteractionResponse -> InteractionResponse -> Ordering
InteractionResponse -> InteractionResponse -> InteractionResponse
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 :: InteractionResponse -> InteractionResponse -> InteractionResponse
$cmin :: InteractionResponse -> InteractionResponse -> InteractionResponse
max :: InteractionResponse -> InteractionResponse -> InteractionResponse
$cmax :: InteractionResponse -> InteractionResponse -> InteractionResponse
>= :: InteractionResponse -> InteractionResponse -> Bool
$c>= :: InteractionResponse -> InteractionResponse -> Bool
> :: InteractionResponse -> InteractionResponse -> Bool
$c> :: InteractionResponse -> InteractionResponse -> Bool
<= :: InteractionResponse -> InteractionResponse -> Bool
$c<= :: InteractionResponse -> InteractionResponse -> Bool
< :: InteractionResponse -> InteractionResponse -> Bool
$c< :: InteractionResponse -> InteractionResponse -> Bool
compare :: InteractionResponse -> InteractionResponse -> Ordering
$ccompare :: InteractionResponse -> InteractionResponse -> Ordering
$cp1Ord :: Eq InteractionResponse
Ord)

-- | A basic interaction response, sending back the given text.
interactionResponseBasic :: T.Text -> InteractionResponse
interactionResponseBasic :: InteractionToken -> InteractionResponse
interactionResponseBasic InteractionToken
t = InteractionResponseMessage -> InteractionResponse
InteractionResponseChannelMessage (InteractionToken -> InteractionResponseMessage
interactionResponseMessageBasic InteractionToken
t)

instance ToJSON InteractionResponse where
  toJSON :: InteractionResponse -> Value
toJSON InteractionResponse
InteractionResponsePong = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
1)]
  toJSON InteractionResponse
InteractionResponseDeferChannelMessage = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
5)]
  toJSON InteractionResponse
InteractionResponseDeferUpdateMessage = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
6)]
  toJSON (InteractionResponseChannelMessage InteractionResponseMessage
ms) = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
4), (Key
"data", InteractionResponseMessage -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionResponseMessage
ms)]
  toJSON (InteractionResponseUpdateMessage InteractionResponseMessage
ms) = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
7), (Key
"data", InteractionResponseMessage -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionResponseMessage
ms)]
  toJSON (InteractionResponseAutocompleteResult InteractionResponseAutocomplete
ms) = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
8), (Key
"data", InteractionResponseAutocomplete -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionResponseAutocomplete
ms)]
  toJSON (InteractionResponseModal InteractionResponseModalData
ms) = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
9), (Key
"data", InteractionResponseModalData -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionResponseModalData
ms)]

data InteractionResponseAutocomplete = InteractionResponseAutocompleteString [Choice T.Text] | InteractionResponseAutocompleteInteger [Choice Integer] | InteractionResponseAutocompleteNumber [Choice Scientific]
  deriving (Int -> InteractionResponseAutocomplete -> ShowS
[InteractionResponseAutocomplete] -> ShowS
InteractionResponseAutocomplete -> String
(Int -> InteractionResponseAutocomplete -> ShowS)
-> (InteractionResponseAutocomplete -> String)
-> ([InteractionResponseAutocomplete] -> ShowS)
-> Show InteractionResponseAutocomplete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseAutocomplete] -> ShowS
$cshowList :: [InteractionResponseAutocomplete] -> ShowS
show :: InteractionResponseAutocomplete -> String
$cshow :: InteractionResponseAutocomplete -> String
showsPrec :: Int -> InteractionResponseAutocomplete -> ShowS
$cshowsPrec :: Int -> InteractionResponseAutocomplete -> ShowS
Show, ReadPrec [InteractionResponseAutocomplete]
ReadPrec InteractionResponseAutocomplete
Int -> ReadS InteractionResponseAutocomplete
ReadS [InteractionResponseAutocomplete]
(Int -> ReadS InteractionResponseAutocomplete)
-> ReadS [InteractionResponseAutocomplete]
-> ReadPrec InteractionResponseAutocomplete
-> ReadPrec [InteractionResponseAutocomplete]
-> Read InteractionResponseAutocomplete
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseAutocomplete]
$creadListPrec :: ReadPrec [InteractionResponseAutocomplete]
readPrec :: ReadPrec InteractionResponseAutocomplete
$creadPrec :: ReadPrec InteractionResponseAutocomplete
readList :: ReadS [InteractionResponseAutocomplete]
$creadList :: ReadS [InteractionResponseAutocomplete]
readsPrec :: Int -> ReadS InteractionResponseAutocomplete
$creadsPrec :: Int -> ReadS InteractionResponseAutocomplete
Read, InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
(InteractionResponseAutocomplete
 -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> Eq InteractionResponseAutocomplete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c/= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
== :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c== :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
Eq, Eq InteractionResponseAutocomplete
Eq InteractionResponseAutocomplete
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Ordering)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete)
-> Ord InteractionResponseAutocomplete
InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
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 :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
$cmin :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
max :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
$cmax :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
>= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c>= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
> :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c> :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
<= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c<= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
< :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c< :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
compare :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
$ccompare :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
$cp1Ord :: Eq InteractionResponseAutocomplete
Ord)

instance ToJSON InteractionResponseAutocomplete where
  toJSON :: InteractionResponseAutocomplete -> Value
toJSON (InteractionResponseAutocompleteString [Choice InteractionToken]
cs) = [Pair] -> Value
object [(Key
"choices", [Choice InteractionToken] -> Value
forall a. ToJSON a => a -> Value
toJSON [Choice InteractionToken]
cs)]
  toJSON (InteractionResponseAutocompleteInteger [Choice Integer]
cs) = [Pair] -> Value
object [(Key
"choices", [Choice Integer] -> Value
forall a. ToJSON a => a -> Value
toJSON [Choice Integer]
cs)]
  toJSON (InteractionResponseAutocompleteNumber [Choice Scientific]
cs) = [Pair] -> Value
object [(Key
"choices", [Choice Scientific] -> Value
forall a. ToJSON a => a -> Value
toJSON [Choice Scientific]
cs)]

-- | A cut down message structure.
data InteractionResponseMessage = InteractionResponseMessage
  { InteractionResponseMessage -> Maybe Bool
interactionResponseMessageTTS :: Maybe Bool,
    InteractionResponseMessage -> Maybe InteractionToken
interactionResponseMessageContent :: Maybe T.Text,
    InteractionResponseMessage -> Maybe [CreateEmbed]
interactionResponseMessageEmbeds :: Maybe [CreateEmbed],
    InteractionResponseMessage -> Maybe AllowedMentions
interactionResponseMessageAllowedMentions :: Maybe AllowedMentions,
    InteractionResponseMessage -> Maybe InteractionResponseMessageFlags
interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags,
    InteractionResponseMessage -> Maybe [ComponentActionRow]
interactionResponseMessageComponents :: Maybe [ComponentActionRow],
    InteractionResponseMessage -> Maybe [Attachment]
interactionResponseMessageAttachments :: Maybe [Attachment]
  }
  deriving (Int -> InteractionResponseMessage -> ShowS
[InteractionResponseMessage] -> ShowS
InteractionResponseMessage -> String
(Int -> InteractionResponseMessage -> ShowS)
-> (InteractionResponseMessage -> String)
-> ([InteractionResponseMessage] -> ShowS)
-> Show InteractionResponseMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseMessage] -> ShowS
$cshowList :: [InteractionResponseMessage] -> ShowS
show :: InteractionResponseMessage -> String
$cshow :: InteractionResponseMessage -> String
showsPrec :: Int -> InteractionResponseMessage -> ShowS
$cshowsPrec :: Int -> InteractionResponseMessage -> ShowS
Show, ReadPrec [InteractionResponseMessage]
ReadPrec InteractionResponseMessage
Int -> ReadS InteractionResponseMessage
ReadS [InteractionResponseMessage]
(Int -> ReadS InteractionResponseMessage)
-> ReadS [InteractionResponseMessage]
-> ReadPrec InteractionResponseMessage
-> ReadPrec [InteractionResponseMessage]
-> Read InteractionResponseMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseMessage]
$creadListPrec :: ReadPrec [InteractionResponseMessage]
readPrec :: ReadPrec InteractionResponseMessage
$creadPrec :: ReadPrec InteractionResponseMessage
readList :: ReadS [InteractionResponseMessage]
$creadList :: ReadS [InteractionResponseMessage]
readsPrec :: Int -> ReadS InteractionResponseMessage
$creadsPrec :: Int -> ReadS InteractionResponseMessage
Read, InteractionResponseMessage -> InteractionResponseMessage -> Bool
(InteractionResponseMessage -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> Eq InteractionResponseMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c/= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
== :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c== :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
Eq, Eq InteractionResponseMessage
Eq InteractionResponseMessage
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Ordering)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> InteractionResponseMessage)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> InteractionResponseMessage)
-> Ord InteractionResponseMessage
InteractionResponseMessage -> InteractionResponseMessage -> Bool
InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
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 :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
$cmin :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
max :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
$cmax :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
>= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c>= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
> :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c> :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
<= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c<= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
< :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c< :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
compare :: InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
$ccompare :: InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
$cp1Ord :: Eq InteractionResponseMessage
Ord)

-- | A basic interaction response, sending back the given text. This is
-- effectively a helper function.
interactionResponseMessageBasic :: T.Text -> InteractionResponseMessage
interactionResponseMessageBasic :: InteractionToken -> InteractionResponseMessage
interactionResponseMessageBasic InteractionToken
t = Maybe Bool
-> Maybe InteractionToken
-> Maybe [CreateEmbed]
-> Maybe AllowedMentions
-> Maybe InteractionResponseMessageFlags
-> Maybe [ComponentActionRow]
-> Maybe [Attachment]
-> InteractionResponseMessage
InteractionResponseMessage Maybe Bool
forall a. Maybe a
Nothing (InteractionToken -> Maybe InteractionToken
forall a. a -> Maybe a
Just InteractionToken
t) Maybe [CreateEmbed]
forall a. Maybe a
Nothing Maybe AllowedMentions
forall a. Maybe a
Nothing Maybe InteractionResponseMessageFlags
forall a. Maybe a
Nothing Maybe [ComponentActionRow]
forall a. Maybe a
Nothing Maybe [Attachment]
forall a. Maybe a
Nothing

instance ToJSON InteractionResponseMessage where
  toJSON :: InteractionResponseMessage -> Value
toJSON InteractionResponseMessage {Maybe Bool
Maybe [CreateEmbed]
Maybe [ComponentActionRow]
Maybe [Attachment]
Maybe InteractionToken
Maybe AllowedMentions
Maybe InteractionResponseMessageFlags
interactionResponseMessageAttachments :: Maybe [Attachment]
interactionResponseMessageComponents :: Maybe [ComponentActionRow]
interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags
interactionResponseMessageAllowedMentions :: Maybe AllowedMentions
interactionResponseMessageEmbeds :: Maybe [CreateEmbed]
interactionResponseMessageContent :: Maybe InteractionToken
interactionResponseMessageTTS :: Maybe Bool
interactionResponseMessageAttachments :: InteractionResponseMessage -> Maybe [Attachment]
interactionResponseMessageComponents :: InteractionResponseMessage -> Maybe [ComponentActionRow]
interactionResponseMessageFlags :: InteractionResponseMessage -> Maybe InteractionResponseMessageFlags
interactionResponseMessageAllowedMentions :: InteractionResponseMessage -> Maybe AllowedMentions
interactionResponseMessageEmbeds :: InteractionResponseMessage -> Maybe [CreateEmbed]
interactionResponseMessageContent :: InteractionResponseMessage -> Maybe InteractionToken
interactionResponseMessageTTS :: InteractionResponseMessage -> Maybe Bool
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"tts", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
interactionResponseMessageTTS),
              (Key
"content", InteractionToken -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionToken -> Value)
-> Maybe InteractionToken -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionToken
interactionResponseMessageContent),
              (Key
"embeds", [Embed] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Embed] -> Value)
-> ([CreateEmbed] -> [Embed]) -> [CreateEmbed] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CreateEmbed -> Embed
createEmbed (CreateEmbed -> Embed) -> [CreateEmbed] -> [Embed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([CreateEmbed] -> Value) -> Maybe [CreateEmbed] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CreateEmbed]
interactionResponseMessageEmbeds),
              (Key
"allowed_mentions", AllowedMentions -> Value
forall a. ToJSON a => a -> Value
toJSON (AllowedMentions -> Value) -> Maybe AllowedMentions -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AllowedMentions
interactionResponseMessageAllowedMentions),
              (Key
"flags", InteractionResponseMessageFlags -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionResponseMessageFlags -> Value)
-> Maybe InteractionResponseMessageFlags -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionResponseMessageFlags
interactionResponseMessageFlags),
              (Key
"components", [ComponentActionRow] -> Value
forall a. ToJSON a => a -> Value
toJSON ([ComponentActionRow] -> Value)
-> Maybe [ComponentActionRow] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ComponentActionRow]
interactionResponseMessageComponents),
              (Key
"attachments", [Attachment] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Attachment] -> Value) -> Maybe [Attachment] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Attachment]
interactionResponseMessageAttachments)
            ]
      ]

-- | Types of flags to attach to the interaction message.
--
-- Currently the only flag is EPHERMERAL, which means only the user can see the
-- message.
data InteractionResponseMessageFlag = InteractionResponseMessageFlagEphermeral
  deriving (Int -> InteractionResponseMessageFlag -> ShowS
[InteractionResponseMessageFlag] -> ShowS
InteractionResponseMessageFlag -> String
(Int -> InteractionResponseMessageFlag -> ShowS)
-> (InteractionResponseMessageFlag -> String)
-> ([InteractionResponseMessageFlag] -> ShowS)
-> Show InteractionResponseMessageFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseMessageFlag] -> ShowS
$cshowList :: [InteractionResponseMessageFlag] -> ShowS
show :: InteractionResponseMessageFlag -> String
$cshow :: InteractionResponseMessageFlag -> String
showsPrec :: Int -> InteractionResponseMessageFlag -> ShowS
$cshowsPrec :: Int -> InteractionResponseMessageFlag -> ShowS
Show, ReadPrec [InteractionResponseMessageFlag]
ReadPrec InteractionResponseMessageFlag
Int -> ReadS InteractionResponseMessageFlag
ReadS [InteractionResponseMessageFlag]
(Int -> ReadS InteractionResponseMessageFlag)
-> ReadS [InteractionResponseMessageFlag]
-> ReadPrec InteractionResponseMessageFlag
-> ReadPrec [InteractionResponseMessageFlag]
-> Read InteractionResponseMessageFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseMessageFlag]
$creadListPrec :: ReadPrec [InteractionResponseMessageFlag]
readPrec :: ReadPrec InteractionResponseMessageFlag
$creadPrec :: ReadPrec InteractionResponseMessageFlag
readList :: ReadS [InteractionResponseMessageFlag]
$creadList :: ReadS [InteractionResponseMessageFlag]
readsPrec :: Int -> ReadS InteractionResponseMessageFlag
$creadsPrec :: Int -> ReadS InteractionResponseMessageFlag
Read, InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
(InteractionResponseMessageFlag
 -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> Eq InteractionResponseMessageFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c/= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
== :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c== :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
Eq, Eq InteractionResponseMessageFlag
Eq InteractionResponseMessageFlag
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Ordering)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag)
-> Ord InteractionResponseMessageFlag
InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
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 :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
$cmin :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
max :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
$cmax :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
>= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c>= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
> :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c> :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
<= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c<= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
< :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c< :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
compare :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
$ccompare :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
$cp1Ord :: Eq InteractionResponseMessageFlag
Ord)

newtype InteractionResponseMessageFlags = InteractionResponseMessageFlags [InteractionResponseMessageFlag]
  deriving (Int -> InteractionResponseMessageFlags -> ShowS
[InteractionResponseMessageFlags] -> ShowS
InteractionResponseMessageFlags -> String
(Int -> InteractionResponseMessageFlags -> ShowS)
-> (InteractionResponseMessageFlags -> String)
-> ([InteractionResponseMessageFlags] -> ShowS)
-> Show InteractionResponseMessageFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseMessageFlags] -> ShowS
$cshowList :: [InteractionResponseMessageFlags] -> ShowS
show :: InteractionResponseMessageFlags -> String
$cshow :: InteractionResponseMessageFlags -> String
showsPrec :: Int -> InteractionResponseMessageFlags -> ShowS
$cshowsPrec :: Int -> InteractionResponseMessageFlags -> ShowS
Show, ReadPrec [InteractionResponseMessageFlags]
ReadPrec InteractionResponseMessageFlags
Int -> ReadS InteractionResponseMessageFlags
ReadS [InteractionResponseMessageFlags]
(Int -> ReadS InteractionResponseMessageFlags)
-> ReadS [InteractionResponseMessageFlags]
-> ReadPrec InteractionResponseMessageFlags
-> ReadPrec [InteractionResponseMessageFlags]
-> Read InteractionResponseMessageFlags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseMessageFlags]
$creadListPrec :: ReadPrec [InteractionResponseMessageFlags]
readPrec :: ReadPrec InteractionResponseMessageFlags
$creadPrec :: ReadPrec InteractionResponseMessageFlags
readList :: ReadS [InteractionResponseMessageFlags]
$creadList :: ReadS [InteractionResponseMessageFlags]
readsPrec :: Int -> ReadS InteractionResponseMessageFlags
$creadsPrec :: Int -> ReadS InteractionResponseMessageFlags
Read, InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
(InteractionResponseMessageFlags
 -> InteractionResponseMessageFlags -> Bool)
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags -> Bool)
-> Eq InteractionResponseMessageFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c/= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
== :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c== :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
Eq, Eq InteractionResponseMessageFlags
Eq InteractionResponseMessageFlags
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags -> Ordering)
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags -> Bool)
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags -> Bool)
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags -> Bool)
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags -> Bool)
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags)
-> (InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags
    -> InteractionResponseMessageFlags)
-> Ord InteractionResponseMessageFlags
InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Ordering
InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
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 :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
$cmin :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
max :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
$cmax :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
>= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c>= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
> :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c> :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
<= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c<= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
< :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c< :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
compare :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Ordering
$ccompare :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Ordering
$cp1Ord :: Eq InteractionResponseMessageFlags
Ord)

instance Enum InteractionResponseMessageFlag where
  fromEnum :: InteractionResponseMessageFlag -> Int
fromEnum InteractionResponseMessageFlag
InteractionResponseMessageFlagEphermeral = Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
6
  toEnum :: Int -> InteractionResponseMessageFlag
toEnum Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
6 = InteractionResponseMessageFlag
InteractionResponseMessageFlagEphermeral
    | Bool
otherwise = String -> InteractionResponseMessageFlag
forall a. HasCallStack => String -> a
error (String -> InteractionResponseMessageFlag)
-> String -> InteractionResponseMessageFlag
forall a b. (a -> b) -> a -> b
$ String
"could not find InteractionCallbackDataFlag `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"`"

instance ToJSON InteractionResponseMessageFlags where
  toJSON :: InteractionResponseMessageFlags -> Value
toJSON (InteractionResponseMessageFlags [InteractionResponseMessageFlag]
fs) = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Integer -> Scientific
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
0 (InteractionResponseMessageFlag -> Int
forall a. Enum a => a -> Int
fromEnum (InteractionResponseMessageFlag -> Int)
-> [InteractionResponseMessageFlag] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InteractionResponseMessageFlag]
fs)

data InteractionResponseModalData = InteractionResponseModalData
  { InteractionResponseModalData -> InteractionToken
interactionResponseModalCustomId :: T.Text,
    InteractionResponseModalData -> InteractionToken
interactionResponseModalTitle :: T.Text,
    InteractionResponseModalData -> [ComponentTextInput]
interactionResponseModalComponents :: [ComponentTextInput]
  }
  deriving (Int -> InteractionResponseModalData -> ShowS
[InteractionResponseModalData] -> ShowS
InteractionResponseModalData -> String
(Int -> InteractionResponseModalData -> ShowS)
-> (InteractionResponseModalData -> String)
-> ([InteractionResponseModalData] -> ShowS)
-> Show InteractionResponseModalData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseModalData] -> ShowS
$cshowList :: [InteractionResponseModalData] -> ShowS
show :: InteractionResponseModalData -> String
$cshow :: InteractionResponseModalData -> String
showsPrec :: Int -> InteractionResponseModalData -> ShowS
$cshowsPrec :: Int -> InteractionResponseModalData -> ShowS
Show, ReadPrec [InteractionResponseModalData]
ReadPrec InteractionResponseModalData
Int -> ReadS InteractionResponseModalData
ReadS [InteractionResponseModalData]
(Int -> ReadS InteractionResponseModalData)
-> ReadS [InteractionResponseModalData]
-> ReadPrec InteractionResponseModalData
-> ReadPrec [InteractionResponseModalData]
-> Read InteractionResponseModalData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseModalData]
$creadListPrec :: ReadPrec [InteractionResponseModalData]
readPrec :: ReadPrec InteractionResponseModalData
$creadPrec :: ReadPrec InteractionResponseModalData
readList :: ReadS [InteractionResponseModalData]
$creadList :: ReadS [InteractionResponseModalData]
readsPrec :: Int -> ReadS InteractionResponseModalData
$creadsPrec :: Int -> ReadS InteractionResponseModalData
Read, InteractionResponseModalData
-> InteractionResponseModalData -> Bool
(InteractionResponseModalData
 -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> Eq InteractionResponseModalData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c/= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
== :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c== :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
Eq, Eq InteractionResponseModalData
Eq InteractionResponseModalData
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Ordering)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> InteractionResponseModalData)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> InteractionResponseModalData)
-> Ord InteractionResponseModalData
InteractionResponseModalData
-> InteractionResponseModalData -> Bool
InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
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 :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
$cmin :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
max :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
$cmax :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
>= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c>= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
> :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c> :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
<= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c<= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
< :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c< :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
compare :: InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
$ccompare :: InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
$cp1Ord :: Eq InteractionResponseModalData
Ord)

instance ToJSON InteractionResponseModalData where
  toJSON :: InteractionResponseModalData -> Value
toJSON InteractionResponseModalData {[ComponentTextInput]
InteractionToken
interactionResponseModalComponents :: [ComponentTextInput]
interactionResponseModalTitle :: InteractionToken
interactionResponseModalCustomId :: InteractionToken
interactionResponseModalComponents :: InteractionResponseModalData -> [ComponentTextInput]
interactionResponseModalTitle :: InteractionResponseModalData -> InteractionToken
interactionResponseModalCustomId :: InteractionResponseModalData -> InteractionToken
..} =
    [Pair] -> Value
object
      [ (Key
"custom_id", InteractionToken -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionToken
interactionResponseModalCustomId),
        (Key
"title", InteractionToken -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionToken
interactionResponseModalTitle),
        (Key
"components", [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (ComponentTextInput -> Value) -> [ComponentTextInput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\ComponentTextInput
ti -> [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
1), (Key
"components", [ComponentTextInput] -> Value
forall a. ToJSON a => a -> Value
toJSON [ComponentTextInput
ti])]) [ComponentTextInput]
interactionResponseModalComponents)
      ]