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

module Discord.Internal.Types.Interactions
  ( Interaction (..),
    ComponentData (..),
    ApplicationCommandData (..),
    OptionsData (..),
    OptionDataSubcommandOrGroup (..),
    OptionDataSubcommand (..),
    OptionDataValue (..),
    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 qualified Data.Text as T
import Discord.Internal.Types.ApplicationCommands (Choice, Number)
import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message)
import Discord.Internal.Types.Components (ActionRow, TextInput)
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 -> ApplicationId
interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        Interaction -> ComponentData
componentData :: ComponentData,
        -- | What guild this interaction comes from.
        Interaction -> Maybe GuildId
interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        Interaction -> Maybe ChannelId
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 -> Text
interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        Interaction -> Maybe Text
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 -> ApplicationCommandData
applicationCommandData :: ApplicationCommandData,
        -- | 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.
        applicationCommandData :: ApplicationCommandData,
        -- | 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 -> ModalData
modalData :: ModalData,
        -- | 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 -> Text -> Parser InteractionId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
          ApplicationId
aid <- Object
v Object -> Text -> Parser ApplicationId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"application_id"
          Maybe GuildId
gid <- Object
v Object -> Text -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"guild_id"
          Maybe ChannelId
cid <- Object
v Object -> Text -> Parser (Maybe ChannelId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channel_id"
          InteractionToken
tok <- Object
v Object -> Text -> Parser InteractionToken
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"token"
          Int
version <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"version"
          Maybe Text
glocale <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"guild_locale"
          Int
t <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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
-> ApplicationId -> InteractionToken -> Int -> Interaction
InteractionPing InteractionId
iid ApplicationId
aid InteractionToken
tok Int
version
            Int
2 ->
              InteractionId
-> ApplicationId
-> ApplicationCommandData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Text
-> Maybe Text
-> Interaction
InteractionApplicationCommand InteractionId
iid ApplicationId
aid
                (ApplicationCommandData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ApplicationCommandData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ApplicationCommandData
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken -> Int -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser InteractionToken
-> Parser (Int -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser Int -> Parser (Text -> Maybe Text -> 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 (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
3 ->
              InteractionId
-> ApplicationId
-> ComponentData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Message
-> Text
-> Maybe Text
-> Interaction
InteractionComponent InteractionId
iid ApplicationId
aid
                (ComponentData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Message
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ComponentData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ComponentData
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int -> Message -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser InteractionToken
-> Parser (Int -> Message -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser Int
-> Parser (Message -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser Message -> Parser (Text -> Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Message
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"message"
                Parser (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
4 ->
              InteractionId
-> ApplicationId
-> ApplicationCommandData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Text
-> Maybe Text
-> Interaction
InteractionApplicationCommandAutocomplete InteractionId
iid ApplicationId
aid
                (ApplicationCommandData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ApplicationCommandData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ApplicationCommandData
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken -> Int -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser InteractionToken
-> Parser (Int -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser Int -> Parser (Text -> Maybe Text -> 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 (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
5 ->
              InteractionId
-> ApplicationId
-> ModalData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Text
-> Maybe Text
-> Interaction
InteractionModalSubmit InteractionId
iid ApplicationId
aid
                (ModalData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ModalData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ModalData
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken -> Int -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser InteractionToken
-> Parser (Int -> Text -> Maybe Text -> 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 -> Text -> Maybe Text -> Interaction)
-> Parser Int -> Parser (Text -> Maybe Text -> 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 (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
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 -> Text -> Parser GuildMember
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"))
      )

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

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

data ApplicationCommandData
  = ApplicationCommandDataUser
      { -- | Id of the invoked command.
        ApplicationCommandData -> ApplicationCommandId
applicationCommandDataId :: ApplicationCommandId,
        -- | Name of the invoked command.
        ApplicationCommandData -> Text
applicationCommandDataName :: T.Text,
        -- | The resolved data in the command.
        ApplicationCommandData -> Maybe ResolvedData
resolvedData :: Maybe ResolvedData,
        -- | The id of the user that is the target.
        ApplicationCommandData -> UserId
applicationCommandDataTargetUserId :: UserId
      }
  | ApplicationCommandDataMessage
      { -- | Id of the invoked command.
        applicationCommandDataId :: ApplicationCommandId,
        -- | Name of the invoked command.
        applicationCommandDataName :: T.Text,
        -- | The resolved data in the command.
        resolvedData :: Maybe ResolvedData,
        -- | The id of the message that is the target.
        ApplicationCommandData -> MessageId
applicationCommandDataTargetMessageId :: MessageId
      }
  | ApplicationCommandDataChatInput
      { -- | Id of the invoked command.
        applicationCommandDataId :: ApplicationCommandId,
        -- | Name of the invoked command.
        applicationCommandDataName :: T.Text,
        -- | The resolved data in the command.
        resolvedData :: Maybe ResolvedData,
        -- | The options of the application command.
        ApplicationCommandData -> Maybe OptionsData
optionsData :: Maybe OptionsData
      }
  deriving (Int -> ApplicationCommandData -> ShowS
[ApplicationCommandData] -> ShowS
ApplicationCommandData -> String
(Int -> ApplicationCommandData -> ShowS)
-> (ApplicationCommandData -> String)
-> ([ApplicationCommandData] -> ShowS)
-> Show ApplicationCommandData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandData] -> ShowS
$cshowList :: [ApplicationCommandData] -> ShowS
show :: ApplicationCommandData -> String
$cshow :: ApplicationCommandData -> String
showsPrec :: Int -> ApplicationCommandData -> ShowS
$cshowsPrec :: Int -> ApplicationCommandData -> ShowS
Show, ReadPrec [ApplicationCommandData]
ReadPrec ApplicationCommandData
Int -> ReadS ApplicationCommandData
ReadS [ApplicationCommandData]
(Int -> ReadS ApplicationCommandData)
-> ReadS [ApplicationCommandData]
-> ReadPrec ApplicationCommandData
-> ReadPrec [ApplicationCommandData]
-> Read ApplicationCommandData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandData]
$creadListPrec :: ReadPrec [ApplicationCommandData]
readPrec :: ReadPrec ApplicationCommandData
$creadPrec :: ReadPrec ApplicationCommandData
readList :: ReadS [ApplicationCommandData]
$creadList :: ReadS [ApplicationCommandData]
readsPrec :: Int -> ReadS ApplicationCommandData
$creadsPrec :: Int -> ReadS ApplicationCommandData
Read, ApplicationCommandData -> ApplicationCommandData -> Bool
(ApplicationCommandData -> ApplicationCommandData -> Bool)
-> (ApplicationCommandData -> ApplicationCommandData -> Bool)
-> Eq ApplicationCommandData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c/= :: ApplicationCommandData -> ApplicationCommandData -> Bool
== :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c== :: ApplicationCommandData -> ApplicationCommandData -> Bool
Eq, Eq ApplicationCommandData
Eq ApplicationCommandData
-> (ApplicationCommandData -> ApplicationCommandData -> Ordering)
-> (ApplicationCommandData -> ApplicationCommandData -> Bool)
-> (ApplicationCommandData -> ApplicationCommandData -> Bool)
-> (ApplicationCommandData -> ApplicationCommandData -> Bool)
-> (ApplicationCommandData -> ApplicationCommandData -> Bool)
-> (ApplicationCommandData
    -> ApplicationCommandData -> ApplicationCommandData)
-> (ApplicationCommandData
    -> ApplicationCommandData -> ApplicationCommandData)
-> Ord ApplicationCommandData
ApplicationCommandData -> ApplicationCommandData -> Bool
ApplicationCommandData -> ApplicationCommandData -> Ordering
ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
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 :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
$cmin :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
max :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
$cmax :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
>= :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c>= :: ApplicationCommandData -> ApplicationCommandData -> Bool
> :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c> :: ApplicationCommandData -> ApplicationCommandData -> Bool
<= :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c<= :: ApplicationCommandData -> ApplicationCommandData -> Bool
< :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c< :: ApplicationCommandData -> ApplicationCommandData -> Bool
compare :: ApplicationCommandData -> ApplicationCommandData -> Ordering
$ccompare :: ApplicationCommandData -> ApplicationCommandData -> Ordering
$cp1Ord :: Eq ApplicationCommandData
Ord)

instance FromJSON ApplicationCommandData where
  parseJSON :: Value -> Parser ApplicationCommandData
parseJSON =
    String
-> (Object -> Parser ApplicationCommandData)
-> Value
-> Parser ApplicationCommandData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommandData"
      ( \Object
v -> do
          ApplicationCommandId
aci <- Object
v Object -> Text -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
          Text
name <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
          Maybe ResolvedData
rd <- Object
v Object -> Text -> Parser (Maybe ResolvedData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"resolved_data"
          Int
t <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
          case Int
t of
            Int
1 ->
              ApplicationCommandId
-> Text
-> Maybe ResolvedData
-> Maybe OptionsData
-> ApplicationCommandData
ApplicationCommandDataChatInput ApplicationCommandId
aci Text
name Maybe ResolvedData
rd
                (Maybe OptionsData -> ApplicationCommandData)
-> Parser (Maybe OptionsData) -> Parser ApplicationCommandData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe OptionsData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"options"
            Int
2 ->
              ApplicationCommandId
-> Text -> Maybe ResolvedData -> UserId -> ApplicationCommandData
ApplicationCommandDataUser ApplicationCommandId
aci Text
name Maybe ResolvedData
rd
                (UserId -> ApplicationCommandData)
-> Parser UserId -> Parser ApplicationCommandData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"target_id"
            Int
3 ->
              ApplicationCommandId
-> Text
-> Maybe ResolvedData
-> MessageId
-> ApplicationCommandData
ApplicationCommandDataMessage ApplicationCommandId
aci Text
name Maybe ResolvedData
rd
                (MessageId -> ApplicationCommandData)
-> Parser MessageId -> Parser ApplicationCommandData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser MessageId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"target_id"
            Int
_ -> String -> Parser ApplicationCommandData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown interaction data component type"
      )

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

instance FromJSON OptionsData where
  parseJSON :: Value -> Parser OptionsData
parseJSON =
    String
-> (Array -> Parser OptionsData) -> Value -> Parser OptionsData
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray
      String
"OptionsData"
      ( \Array
a -> do
          let a' :: [Value]
a' = Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
          case [Value]
a' of
            [] -> OptionsData -> Parser OptionsData
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionsData -> Parser OptionsData)
-> OptionsData -> Parser OptionsData
forall a b. (a -> b) -> a -> b
$ [OptionDataValue] -> OptionsData
OptionsDataValues []
            (Value
v' : [Value]
_) ->
              String
-> (Object -> Parser OptionsData) -> Value -> Parser OptionsData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
                String
"OptionsData item"
                ( \Object
v -> do
                    Int
t <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 [OptionDataSubcommandOrGroup] -> OptionsData
OptionsDataSubcommands ([OptionDataSubcommandOrGroup] -> OptionsData)
-> Parser [OptionDataSubcommandOrGroup] -> Parser OptionsData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser OptionDataSubcommandOrGroup)
-> [Value] -> Parser [OptionDataSubcommandOrGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser OptionDataSubcommandOrGroup
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                      else [OptionDataValue] -> OptionsData
OptionsDataValues ([OptionDataValue] -> OptionsData)
-> Parser [OptionDataValue] -> Parser OptionsData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser OptionDataValue)
-> [Value] -> Parser [OptionDataValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser OptionDataValue
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                )
                Value
v'
      )

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

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

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

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

-- | Data for a single value.
data OptionDataValue
  = OptionDataValueString
      { OptionDataValue -> Text
optionDataValueName :: T.Text,
        OptionDataValue -> Either Text Text
optionDataValueString :: Either T.Text T.Text
      }
  | OptionDataValueInteger
      { optionDataValueName :: T.Text,
        OptionDataValue -> Either Text Integer
optionDataValueInteger :: Either T.Text Integer
      }
  | OptionDataValueBoolean
      { optionDataValueName :: T.Text,
        OptionDataValue -> Bool
optionDataValueBoolean :: Bool
      }
  | OptionDataValueUser
      { optionDataValueName :: T.Text,
        OptionDataValue -> UserId
optionDataValueUser :: UserId
      }
  | OptionDataValueChannel
      { optionDataValueName :: T.Text,
        OptionDataValue -> ChannelId
optionDataValueChannel :: ChannelId
      }
  | OptionDataValueRole
      { optionDataValueName :: T.Text,
        OptionDataValue -> RoleId
optionDataValueRole :: RoleId
      }
  | OptionDataValueMentionable
      { optionDataValueName :: T.Text,
        OptionDataValue -> Snowflake
optionDataValueMentionable :: Snowflake
      }
  | OptionDataValueNumber
      { optionDataValueName :: T.Text,
        OptionDataValue -> Either Text Number
optionDataValueNumber :: Either T.Text Number
      }
  deriving (Int -> OptionDataValue -> ShowS
[OptionDataValue] -> ShowS
OptionDataValue -> String
(Int -> OptionDataValue -> ShowS)
-> (OptionDataValue -> String)
-> ([OptionDataValue] -> ShowS)
-> Show OptionDataValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionDataValue] -> ShowS
$cshowList :: [OptionDataValue] -> ShowS
show :: OptionDataValue -> String
$cshow :: OptionDataValue -> String
showsPrec :: Int -> OptionDataValue -> ShowS
$cshowsPrec :: Int -> OptionDataValue -> ShowS
Show, ReadPrec [OptionDataValue]
ReadPrec OptionDataValue
Int -> ReadS OptionDataValue
ReadS [OptionDataValue]
(Int -> ReadS OptionDataValue)
-> ReadS [OptionDataValue]
-> ReadPrec OptionDataValue
-> ReadPrec [OptionDataValue]
-> Read OptionDataValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptionDataValue]
$creadListPrec :: ReadPrec [OptionDataValue]
readPrec :: ReadPrec OptionDataValue
$creadPrec :: ReadPrec OptionDataValue
readList :: ReadS [OptionDataValue]
$creadList :: ReadS [OptionDataValue]
readsPrec :: Int -> ReadS OptionDataValue
$creadsPrec :: Int -> ReadS OptionDataValue
Read, OptionDataValue -> OptionDataValue -> Bool
(OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> Eq OptionDataValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionDataValue -> OptionDataValue -> Bool
$c/= :: OptionDataValue -> OptionDataValue -> Bool
== :: OptionDataValue -> OptionDataValue -> Bool
$c== :: OptionDataValue -> OptionDataValue -> Bool
Eq, Eq OptionDataValue
Eq OptionDataValue
-> (OptionDataValue -> OptionDataValue -> Ordering)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> OptionDataValue)
-> (OptionDataValue -> OptionDataValue -> OptionDataValue)
-> Ord OptionDataValue
OptionDataValue -> OptionDataValue -> Bool
OptionDataValue -> OptionDataValue -> Ordering
OptionDataValue -> OptionDataValue -> OptionDataValue
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 :: OptionDataValue -> OptionDataValue -> OptionDataValue
$cmin :: OptionDataValue -> OptionDataValue -> OptionDataValue
max :: OptionDataValue -> OptionDataValue -> OptionDataValue
$cmax :: OptionDataValue -> OptionDataValue -> OptionDataValue
>= :: OptionDataValue -> OptionDataValue -> Bool
$c>= :: OptionDataValue -> OptionDataValue -> Bool
> :: OptionDataValue -> OptionDataValue -> Bool
$c> :: OptionDataValue -> OptionDataValue -> Bool
<= :: OptionDataValue -> OptionDataValue -> Bool
$c<= :: OptionDataValue -> OptionDataValue -> Bool
< :: OptionDataValue -> OptionDataValue -> Bool
$c< :: OptionDataValue -> OptionDataValue -> Bool
compare :: OptionDataValue -> OptionDataValue -> Ordering
$ccompare :: OptionDataValue -> OptionDataValue -> Ordering
$cp1Ord :: Eq OptionDataValue
Ord)

instance FromJSON OptionDataValue where
  parseJSON :: Value -> Parser OptionDataValue
parseJSON =
    String
-> (Object -> Parser OptionDataValue)
-> Value
-> Parser OptionDataValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionDataValue"
      ( \Object
v -> do
          Text
name <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
          Bool
focused <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"focused" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
          Int
t <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
          case Int
t of
            Int
3 ->
              Text -> Either Text Text -> OptionDataValue
OptionDataValueString Text
name
                (Either Text Text -> OptionDataValue)
-> Parser (Either Text Text) -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either Text Text)
forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
v Bool
focused
            Int
4 ->
              Text -> Either Text Integer -> OptionDataValue
OptionDataValueInteger Text
name
                (Either Text Integer -> OptionDataValue)
-> Parser (Either Text Integer) -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either Text Integer)
forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
v Bool
focused
            Int
10 ->
              Text -> Either Text Number -> OptionDataValue
OptionDataValueNumber Text
name
                (Either Text Number -> OptionDataValue)
-> Parser (Either Text Number) -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either Text Number)
forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
v Bool
focused
            Int
5 ->
              Text -> Bool -> OptionDataValue
OptionDataValueBoolean Text
name
                (Bool -> OptionDataValue) -> Parser Bool -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
            Int
6 ->
              Text -> UserId -> OptionDataValue
OptionDataValueUser Text
name
                (UserId -> OptionDataValue)
-> Parser UserId -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
            Int
7 ->
              Text -> ChannelId -> OptionDataValue
OptionDataValueChannel Text
name
                (ChannelId -> OptionDataValue)
-> Parser ChannelId -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
            Int
8 ->
              Text -> RoleId -> OptionDataValue
OptionDataValueRole Text
name
                (RoleId -> OptionDataValue)
-> Parser RoleId -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser RoleId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
            Int
9 ->
              Text -> Snowflake -> OptionDataValue
OptionDataValueMentionable Text
name
                (Snowflake -> OptionDataValue)
-> Parser Snowflake -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
            Int
_ -> String -> Parser OptionDataValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser OptionDataValue)
-> String -> Parser OptionDataValue
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 ModalData = ModalData
  { -- | The unique id of the component (up to 100 characters).
    ModalData -> Text
modalDataCustomId :: T.Text,
    -- | Components from the modal.
    ModalData -> [TextInput]
modalDataComponents :: [TextInput]
  }
  deriving (Int -> ModalData -> ShowS
[ModalData] -> ShowS
ModalData -> String
(Int -> ModalData -> ShowS)
-> (ModalData -> String)
-> ([ModalData] -> ShowS)
-> Show ModalData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModalData] -> ShowS
$cshowList :: [ModalData] -> ShowS
show :: ModalData -> String
$cshow :: ModalData -> String
showsPrec :: Int -> ModalData -> ShowS
$cshowsPrec :: Int -> ModalData -> ShowS
Show, ReadPrec [ModalData]
ReadPrec ModalData
Int -> ReadS ModalData
ReadS [ModalData]
(Int -> ReadS ModalData)
-> ReadS [ModalData]
-> ReadPrec ModalData
-> ReadPrec [ModalData]
-> Read ModalData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModalData]
$creadListPrec :: ReadPrec [ModalData]
readPrec :: ReadPrec ModalData
$creadPrec :: ReadPrec ModalData
readList :: ReadS [ModalData]
$creadList :: ReadS [ModalData]
readsPrec :: Int -> ReadS ModalData
$creadsPrec :: Int -> ReadS ModalData
Read, ModalData -> ModalData -> Bool
(ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool) -> Eq ModalData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModalData -> ModalData -> Bool
$c/= :: ModalData -> ModalData -> Bool
== :: ModalData -> ModalData -> Bool
$c== :: ModalData -> ModalData -> Bool
Eq, Eq ModalData
Eq ModalData
-> (ModalData -> ModalData -> Ordering)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> ModalData)
-> (ModalData -> ModalData -> ModalData)
-> Ord ModalData
ModalData -> ModalData -> Bool
ModalData -> ModalData -> Ordering
ModalData -> ModalData -> ModalData
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 :: ModalData -> ModalData -> ModalData
$cmin :: ModalData -> ModalData -> ModalData
max :: ModalData -> ModalData -> ModalData
$cmax :: ModalData -> ModalData -> ModalData
>= :: ModalData -> ModalData -> Bool
$c>= :: ModalData -> ModalData -> Bool
> :: ModalData -> ModalData -> Bool
$c> :: ModalData -> ModalData -> Bool
<= :: ModalData -> ModalData -> Bool
$c<= :: ModalData -> ModalData -> Bool
< :: ModalData -> ModalData -> Bool
$c< :: ModalData -> ModalData -> Bool
compare :: ModalData -> ModalData -> Ordering
$ccompare :: ModalData -> ModalData -> Ordering
$cp1Ord :: Eq ModalData
Ord)

instance FromJSON ModalData where
  parseJSON :: Value -> Parser ModalData
parseJSON =
    String -> (Object -> Parser ModalData) -> Value -> Parser ModalData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ModalData"
      ( \Object
v ->
          Text -> [TextInput] -> ModalData
ModalData (Text -> [TextInput] -> ModalData)
-> Parser Text -> Parser ([TextInput] -> ModalData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"custom_id"
            Parser ([TextInput] -> ModalData)
-> Parser [TextInput] -> Parser ModalData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
v Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"components") Parser [Value]
-> ([Value] -> Parser [TextInput]) -> Parser [TextInput]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([[TextInput]] -> [TextInput]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[TextInput]] -> [TextInput])
-> Parser [[TextInput]] -> Parser [TextInput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser [[TextInput]] -> Parser [TextInput])
-> ([Value] -> Parser [[TextInput]])
-> [Value]
-> Parser [TextInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser [TextInput]) -> [Value] -> Parser [[TextInput]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser [TextInput]
getTextInput)
      )
    where
      getTextInput :: Value -> Parser [TextInput]
      getTextInput :: Value -> Parser [TextInput]
getTextInput = String
-> (Object -> Parser [TextInput]) -> Value -> Parser [TextInput]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModalData.TextInput" ((Object -> Parser [TextInput]) -> Value -> Parser [TextInput])
-> (Object -> Parser [TextInput]) -> Value -> Parser [TextInput]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Int
t <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
        case Int
t of
          Int
1 -> Object
o Object -> Text -> Parser [TextInput]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"components"
          Int
_ -> String -> Parser [TextInput]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser [TextInput]) -> String -> Parser [TextInput]
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 Text a)
parseValue Object
o Bool
True = Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Parser Text -> Parser (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
parseValue Object
o Bool
False = a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a) -> Parser a -> Parser (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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
      [ (Text
name, Value
value)
        | (Text
name, Just Value
value) <-
            [ (Text
"users", Maybe Value
resolvedDataUsers),
              (Text
"members", Maybe Value
resolvedDataMembers),
              (Text
"roles", Maybe Value
resolvedDataRoles),
              (Text
"channels", Maybe Value
resolvedDataChannels),
              (Text
"messages", Maybe Value
resolvedDataMessages),
              (Text
"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 -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 :: Text -> InteractionResponse
interactionResponseBasic Text
t = InteractionResponseMessage -> InteractionResponse
InteractionResponseChannelMessage (Text -> InteractionResponseMessage
interactionResponseMessageBasic Text
t)

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

data InteractionResponseAutocomplete
  = InteractionResponseAutocompleteString [Choice T.Text]
  | InteractionResponseAutocompleteInteger [Choice Integer]
  | InteractionResponseAutocompleteNumber [Choice Number]
  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 Text]
cs) = [Pair] -> Value
object [(Text
"choices", [Choice Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Choice Text]
cs)]
  toJSON (InteractionResponseAutocompleteInteger [Choice Integer]
cs) = [Pair] -> Value
object [(Text
"choices", [Choice Integer] -> Value
forall a. ToJSON a => a -> Value
toJSON [Choice Integer]
cs)]
  toJSON (InteractionResponseAutocompleteNumber [Choice Number]
cs) = [Pair] -> Value
object [(Text
"choices", [Choice Number] -> Value
forall a. ToJSON a => a -> Value
toJSON [Choice Number]
cs)]

-- | A cut down message structure.
data InteractionResponseMessage = InteractionResponseMessage
  { InteractionResponseMessage -> Maybe Bool
interactionResponseMessageTTS :: Maybe Bool,
    InteractionResponseMessage -> Maybe Text
interactionResponseMessageContent :: Maybe T.Text,
    InteractionResponseMessage -> Maybe [CreateEmbed]
interactionResponseMessageEmbeds :: Maybe [CreateEmbed],
    InteractionResponseMessage -> Maybe AllowedMentions
interactionResponseMessageAllowedMentions :: Maybe AllowedMentions,
    InteractionResponseMessage -> Maybe InteractionResponseMessageFlags
interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags,
    InteractionResponseMessage -> Maybe [ActionRow]
interactionResponseMessageComponents :: Maybe [ActionRow],
    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 :: Text -> InteractionResponseMessage
interactionResponseMessageBasic Text
t = Maybe Bool
-> Maybe Text
-> Maybe [CreateEmbed]
-> Maybe AllowedMentions
-> Maybe InteractionResponseMessageFlags
-> Maybe [ActionRow]
-> Maybe [Attachment]
-> InteractionResponseMessage
InteractionResponseMessage Maybe Bool
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t) Maybe [CreateEmbed]
forall a. Maybe a
Nothing Maybe AllowedMentions
forall a. Maybe a
Nothing Maybe InteractionResponseMessageFlags
forall a. Maybe a
Nothing Maybe [ActionRow]
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 [ActionRow]
Maybe [Attachment]
Maybe Text
Maybe AllowedMentions
Maybe InteractionResponseMessageFlags
interactionResponseMessageAttachments :: Maybe [Attachment]
interactionResponseMessageComponents :: Maybe [ActionRow]
interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags
interactionResponseMessageAllowedMentions :: Maybe AllowedMentions
interactionResponseMessageEmbeds :: Maybe [CreateEmbed]
interactionResponseMessageContent :: Maybe Text
interactionResponseMessageTTS :: Maybe Bool
interactionResponseMessageAttachments :: InteractionResponseMessage -> Maybe [Attachment]
interactionResponseMessageComponents :: InteractionResponseMessage -> Maybe [ActionRow]
interactionResponseMessageFlags :: InteractionResponseMessage -> Maybe InteractionResponseMessageFlags
interactionResponseMessageAllowedMentions :: InteractionResponseMessage -> Maybe AllowedMentions
interactionResponseMessageEmbeds :: InteractionResponseMessage -> Maybe [CreateEmbed]
interactionResponseMessageContent :: InteractionResponseMessage -> Maybe Text
interactionResponseMessageTTS :: InteractionResponseMessage -> Maybe Bool
..} =
    [Pair] -> Value
object
      [ (Text
name, Value
value)
        | (Text
name, Just Value
value) <-
            [ (Text
"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),
              (Text
"content", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
interactionResponseMessageContent),
              (Text
"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),
              (Text
"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),
              (Text
"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),
              (Text
"components", [ActionRow] -> Value
forall a. ToJSON a => a -> Value
toJSON ([ActionRow] -> Value) -> Maybe [ActionRow] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ActionRow]
interactionResponseMessageComponents),
              (Text
"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) = Number -> Value
Number (Number -> Value) -> Number -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Number
forall a. Num a => Integer -> a
fromInteger (Integer -> Number) -> Integer -> Number
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 -> Text
interactionResponseModalCustomId :: T.Text,
    InteractionResponseModalData -> Text
interactionResponseModalTitle :: T.Text,
    InteractionResponseModalData -> [TextInput]
interactionResponseModalComponents :: [TextInput]
  }
  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 {[TextInput]
Text
interactionResponseModalComponents :: [TextInput]
interactionResponseModalTitle :: Text
interactionResponseModalCustomId :: Text
interactionResponseModalComponents :: InteractionResponseModalData -> [TextInput]
interactionResponseModalTitle :: InteractionResponseModalData -> Text
interactionResponseModalCustomId :: InteractionResponseModalData -> Text
..} =
    [Pair] -> Value
object
      [ (Text
"custom_id", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
interactionResponseModalCustomId),
        (Text
"title", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
interactionResponseModalTitle),
        (Text
"components", [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (TextInput -> Value) -> [TextInput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\TextInput
ti -> [Pair] -> Value
object [(Text
"type", Number -> Value
Number Number
1), (Text
"components", [TextInput] -> Value
forall a. ToJSON a => a -> Value
toJSON [TextInput
ti])]) [TextInput]
interactionResponseModalComponents)
      ]