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

module Discord.Internal.Types.ApplicationCommands
  ( ApplicationCommand (..),
    ApplicationCommandOptions (..),
    ApplicationCommandOptionSubcommandOrGroup (..),
    ApplicationCommandOptionSubcommand (..),
    ApplicationCommandOptionValue (..),
    createApplicationCommandChatInput,
    createApplicationCommandUser,
    createApplicationCommandMessage,
    CreateApplicationCommand (..),
    EditApplicationCommand (..),
    defaultEditApplicationCommand,
    Choice (..),
    ApplicationCommandChannelType (..),
    GuildApplicationCommandPermissions (..),
    ApplicationCommandPermissions (..),
  )
where

import Data.Aeson
import Data.Aeson.Types (Pair, Parser)
import Data.Data (Data)
import Data.Foldable (Foldable (toList))
import Data.Scientific (Scientific)
import qualified Data.Text as T
import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, InternalDiscordEnum (..), Snowflake, discordTypeParseJSON, toMaybeJSON)

-- | The structure for an application command.
data ApplicationCommand
  = ApplicationCommandUser
      { -- | The id of the application command.
        ApplicationCommand -> ApplicationCommandId
applicationCommandId :: ApplicationCommandId,
        -- | The id of the application the command comes from.
        ApplicationCommand -> ApplicationCommandId
applicationCommandApplicationId :: ApplicationId,
        -- | The guild the application command is registered in.
        ApplicationCommand -> Maybe ApplicationCommandId
applicationCommandGuildId :: Maybe GuildId,
        -- | The name of the application command.
        ApplicationCommand -> Text
applicationCommandName :: T.Text,
        -- | Whether the command is enabled by default when the app is added to a guild.
        ApplicationCommand -> Bool
applicationCommandDefaultPermission :: Bool,
        -- | Autoincrementing version identifier updated during substantial record changes.
        ApplicationCommand -> ApplicationCommandId
applicationCommandVersion :: Snowflake
      }
  | ApplicationCommandMessage
      { -- | The id of the application command.
        applicationCommandId :: ApplicationCommandId,
        -- | The id of the application the command comes from.
        applicationCommandApplicationId :: ApplicationId,
        -- | The guild the application command is registered in.
        applicationCommandGuildId :: Maybe GuildId,
        -- | The name of the application command.
        applicationCommandName :: T.Text,
        -- | Whether the command is enabled by default when the app is added to a guild.
        applicationCommandDefaultPermission :: Bool,
        -- | Autoincrementing version identifier updated during substantial record changes.
        applicationCommandVersion :: Snowflake
      }
  | ApplicationCommandChatInput
      { -- | The id of the application command.
        applicationCommandId :: ApplicationCommandId,
        -- | The id of the application the command comes from.
        applicationCommandApplicationId :: ApplicationId,
        -- | The guild the application command is registered in.
        applicationCommandGuildId :: Maybe GuildId,
        -- | The name of the application command.
        applicationCommandName :: T.Text,
        -- | The description of the application command.
        ApplicationCommand -> Text
applicationCommandDescription :: T.Text,
        -- | The parameters for the command.
        ApplicationCommand -> Maybe ApplicationCommandOptions
applicationCommandOptions :: Maybe ApplicationCommandOptions,
        -- | Whether the command is enabled by default when the app is added to a guild.
        applicationCommandDefaultPermission :: Bool,
        -- | Autoincrementing version identifier updated during substantial record changes.
        applicationCommandVersion :: Snowflake
      }
  deriving (Int -> ApplicationCommand -> ShowS
[ApplicationCommand] -> ShowS
ApplicationCommand -> String
(Int -> ApplicationCommand -> ShowS)
-> (ApplicationCommand -> String)
-> ([ApplicationCommand] -> ShowS)
-> Show ApplicationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommand] -> ShowS
$cshowList :: [ApplicationCommand] -> ShowS
show :: ApplicationCommand -> String
$cshow :: ApplicationCommand -> String
showsPrec :: Int -> ApplicationCommand -> ShowS
$cshowsPrec :: Int -> ApplicationCommand -> ShowS
Show, ApplicationCommand -> ApplicationCommand -> Bool
(ApplicationCommand -> ApplicationCommand -> Bool)
-> (ApplicationCommand -> ApplicationCommand -> Bool)
-> Eq ApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommand -> ApplicationCommand -> Bool
$c/= :: ApplicationCommand -> ApplicationCommand -> Bool
== :: ApplicationCommand -> ApplicationCommand -> Bool
$c== :: ApplicationCommand -> ApplicationCommand -> Bool
Eq, ReadPrec [ApplicationCommand]
ReadPrec ApplicationCommand
Int -> ReadS ApplicationCommand
ReadS [ApplicationCommand]
(Int -> ReadS ApplicationCommand)
-> ReadS [ApplicationCommand]
-> ReadPrec ApplicationCommand
-> ReadPrec [ApplicationCommand]
-> Read ApplicationCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommand]
$creadListPrec :: ReadPrec [ApplicationCommand]
readPrec :: ReadPrec ApplicationCommand
$creadPrec :: ReadPrec ApplicationCommand
readList :: ReadS [ApplicationCommand]
$creadList :: ReadS [ApplicationCommand]
readsPrec :: Int -> ReadS ApplicationCommand
$creadsPrec :: Int -> ReadS ApplicationCommand
Read)

instance FromJSON ApplicationCommand where
  parseJSON :: Value -> Parser ApplicationCommand
parseJSON =
    String
-> (Object -> Parser ApplicationCommand)
-> Value
-> Parser ApplicationCommand
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommand"
      ( \Object
v -> do
          ApplicationCommandId
acid <- Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          ApplicationCommandId
aid <- Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
          Maybe ApplicationCommandId
gid <- Object
v Object -> Key -> Parser (Maybe ApplicationCommandId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
          Text
name <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Bool
defPerm <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_permission" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
          ApplicationCommandId
version <- Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
          Maybe Int
t <- Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type" :: Parser (Maybe Int)
          case Maybe Int
t of
            (Just Int
2) -> ApplicationCommand -> Parser ApplicationCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommand -> Parser ApplicationCommand)
-> ApplicationCommand -> Parser ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Bool
-> ApplicationCommandId
-> ApplicationCommand
ApplicationCommandUser ApplicationCommandId
acid ApplicationCommandId
aid Maybe ApplicationCommandId
gid Text
name Bool
defPerm ApplicationCommandId
version
            (Just Int
3) -> ApplicationCommand -> Parser ApplicationCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommand -> Parser ApplicationCommand)
-> ApplicationCommand -> Parser ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Bool
-> ApplicationCommandId
-> ApplicationCommand
ApplicationCommandMessage ApplicationCommandId
acid ApplicationCommandId
aid Maybe ApplicationCommandId
gid Text
name Bool
defPerm ApplicationCommandId
version
            Maybe Int
_ -> do
              Text
desc <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
              Maybe ApplicationCommandOptions
options <- Object
v Object -> Key -> Parser (Maybe ApplicationCommandOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
              ApplicationCommand -> Parser ApplicationCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommand -> Parser ApplicationCommand)
-> ApplicationCommand -> Parser ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Text
-> Maybe ApplicationCommandOptions
-> Bool
-> ApplicationCommandId
-> ApplicationCommand
ApplicationCommandChatInput ApplicationCommandId
acid ApplicationCommandId
aid Maybe ApplicationCommandId
gid Text
name Text
desc Maybe ApplicationCommandOptions
options Bool
defPerm ApplicationCommandId
version
      )

-- | Either subcommands and groups, or values.
data ApplicationCommandOptions
  = ApplicationCommandOptionsSubcommands [ApplicationCommandOptionSubcommandOrGroup]
  | ApplicationCommandOptionsValues [ApplicationCommandOptionValue]
  deriving (Int -> ApplicationCommandOptions -> ShowS
[ApplicationCommandOptions] -> ShowS
ApplicationCommandOptions -> String
(Int -> ApplicationCommandOptions -> ShowS)
-> (ApplicationCommandOptions -> String)
-> ([ApplicationCommandOptions] -> ShowS)
-> Show ApplicationCommandOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptions] -> ShowS
$cshowList :: [ApplicationCommandOptions] -> ShowS
show :: ApplicationCommandOptions -> String
$cshow :: ApplicationCommandOptions -> String
showsPrec :: Int -> ApplicationCommandOptions -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptions -> ShowS
Show, ApplicationCommandOptions -> ApplicationCommandOptions -> Bool
(ApplicationCommandOptions -> ApplicationCommandOptions -> Bool)
-> (ApplicationCommandOptions -> ApplicationCommandOptions -> Bool)
-> Eq ApplicationCommandOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptions -> ApplicationCommandOptions -> Bool
$c/= :: ApplicationCommandOptions -> ApplicationCommandOptions -> Bool
== :: ApplicationCommandOptions -> ApplicationCommandOptions -> Bool
$c== :: ApplicationCommandOptions -> ApplicationCommandOptions -> Bool
Eq, ReadPrec [ApplicationCommandOptions]
ReadPrec ApplicationCommandOptions
Int -> ReadS ApplicationCommandOptions
ReadS [ApplicationCommandOptions]
(Int -> ReadS ApplicationCommandOptions)
-> ReadS [ApplicationCommandOptions]
-> ReadPrec ApplicationCommandOptions
-> ReadPrec [ApplicationCommandOptions]
-> Read ApplicationCommandOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptions]
$creadListPrec :: ReadPrec [ApplicationCommandOptions]
readPrec :: ReadPrec ApplicationCommandOptions
$creadPrec :: ReadPrec ApplicationCommandOptions
readList :: ReadS [ApplicationCommandOptions]
$creadList :: ReadS [ApplicationCommandOptions]
readsPrec :: Int -> ReadS ApplicationCommandOptions
$creadsPrec :: Int -> ReadS ApplicationCommandOptions
Read)

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

instance ToJSON ApplicationCommandOptions where
  toJSON :: ApplicationCommandOptions -> Value
toJSON (ApplicationCommandOptionsSubcommands [ApplicationCommandOptionSubcommandOrGroup]
o) = [ApplicationCommandOptionSubcommandOrGroup] -> Value
forall a. ToJSON a => a -> Value
toJSON [ApplicationCommandOptionSubcommandOrGroup]
o
  toJSON (ApplicationCommandOptionsValues [ApplicationCommandOptionValue]
o) = [ApplicationCommandOptionValue] -> Value
forall a. ToJSON a => a -> Value
toJSON [ApplicationCommandOptionValue]
o

-- | Either a subcommand group or a subcommand.
data ApplicationCommandOptionSubcommandOrGroup
  = ApplicationCommandOptionSubcommandGroup
      { -- | The name of the subcommand group
        ApplicationCommandOptionSubcommandOrGroup -> Text
applicationCommandOptionSubcommandGroupName :: T.Text,
        -- | The description of the subcommand group
        ApplicationCommandOptionSubcommandOrGroup -> Text
applicationCommandOptionSubcommandGroupDescription :: T.Text,
        -- | The subcommands in this subcommand group
        ApplicationCommandOptionSubcommandOrGroup
-> [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupOptions :: [ApplicationCommandOptionSubcommand]
      }
  | ApplicationCommandOptionSubcommandOrGroupSubcommand ApplicationCommandOptionSubcommand
  deriving (Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS
[ApplicationCommandOptionSubcommandOrGroup] -> ShowS
ApplicationCommandOptionSubcommandOrGroup -> String
(Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS)
-> (ApplicationCommandOptionSubcommandOrGroup -> String)
-> ([ApplicationCommandOptionSubcommandOrGroup] -> ShowS)
-> Show ApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptionSubcommandOrGroup] -> ShowS
$cshowList :: [ApplicationCommandOptionSubcommandOrGroup] -> ShowS
show :: ApplicationCommandOptionSubcommandOrGroup -> String
$cshow :: ApplicationCommandOptionSubcommandOrGroup -> String
showsPrec :: Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS
Show, ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
(ApplicationCommandOptionSubcommandOrGroup
 -> ApplicationCommandOptionSubcommandOrGroup -> Bool)
-> (ApplicationCommandOptionSubcommandOrGroup
    -> ApplicationCommandOptionSubcommandOrGroup -> Bool)
-> Eq ApplicationCommandOptionSubcommandOrGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
$c/= :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
== :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
$c== :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
Eq, ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
ReadPrec ApplicationCommandOptionSubcommandOrGroup
Int -> ReadS ApplicationCommandOptionSubcommandOrGroup
ReadS [ApplicationCommandOptionSubcommandOrGroup]
(Int -> ReadS ApplicationCommandOptionSubcommandOrGroup)
-> ReadS [ApplicationCommandOptionSubcommandOrGroup]
-> ReadPrec ApplicationCommandOptionSubcommandOrGroup
-> ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
-> Read ApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
$creadListPrec :: ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
readPrec :: ReadPrec ApplicationCommandOptionSubcommandOrGroup
$creadPrec :: ReadPrec ApplicationCommandOptionSubcommandOrGroup
readList :: ReadS [ApplicationCommandOptionSubcommandOrGroup]
$creadList :: ReadS [ApplicationCommandOptionSubcommandOrGroup]
readsPrec :: Int -> ReadS ApplicationCommandOptionSubcommandOrGroup
$creadsPrec :: Int -> ReadS ApplicationCommandOptionSubcommandOrGroup
Read)

instance FromJSON ApplicationCommandOptionSubcommandOrGroup where
  parseJSON :: Value -> Parser ApplicationCommandOptionSubcommandOrGroup
parseJSON =
    String
-> (Object -> Parser ApplicationCommandOptionSubcommandOrGroup)
-> Value
-> Parser ApplicationCommandOptionSubcommandOrGroup
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommandOptionSubcommandOrGroup"
      ( \Object
v -> do
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
2 ->
              Text
-> Text
-> [ApplicationCommandOptionSubcommand]
-> ApplicationCommandOptionSubcommandOrGroup
ApplicationCommandOptionSubcommandGroup
                (Text
 -> Text
 -> [ApplicationCommandOptionSubcommand]
 -> ApplicationCommandOptionSubcommandOrGroup)
-> Parser Text
-> Parser
     (Text
      -> [ApplicationCommandOptionSubcommand]
      -> ApplicationCommandOptionSubcommandOrGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Parser
  (Text
   -> [ApplicationCommandOptionSubcommand]
   -> ApplicationCommandOptionSubcommandOrGroup)
-> Parser Text
-> Parser
     ([ApplicationCommandOptionSubcommand]
      -> ApplicationCommandOptionSubcommandOrGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
                Parser
  ([ApplicationCommandOptionSubcommand]
   -> ApplicationCommandOptionSubcommandOrGroup)
-> Parser [ApplicationCommandOptionSubcommand]
-> Parser ApplicationCommandOptionSubcommandOrGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [ApplicationCommandOptionSubcommand]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"options"
            Int
1 -> ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommandOrGroup
ApplicationCommandOptionSubcommandOrGroupSubcommand (ApplicationCommandOptionSubcommand
 -> ApplicationCommandOptionSubcommandOrGroup)
-> Parser ApplicationCommandOptionSubcommand
-> Parser ApplicationCommandOptionSubcommandOrGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApplicationCommandOptionSubcommand
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Int
_ -> String -> Parser ApplicationCommandOptionSubcommandOrGroup
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected subcommand group type"
      )

instance ToJSON ApplicationCommandOptionSubcommandOrGroup where
  toJSON :: ApplicationCommandOptionSubcommandOrGroup -> Value
toJSON ApplicationCommandOptionSubcommandGroup {[ApplicationCommandOptionSubcommand]
Text
applicationCommandOptionSubcommandGroupOptions :: [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupDescription :: Text
applicationCommandOptionSubcommandGroupName :: Text
applicationCommandOptionSubcommandGroupOptions :: ApplicationCommandOptionSubcommandOrGroup
-> [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupDescription :: ApplicationCommandOptionSubcommandOrGroup -> Text
applicationCommandOptionSubcommandGroupName :: ApplicationCommandOptionSubcommandOrGroup -> Text
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
2),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionSubcommandGroupName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionSubcommandGroupDescription),
        (Key
"options", [ApplicationCommandOptionSubcommand] -> Value
forall a. ToJSON a => a -> Value
toJSON [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupOptions)
      ]
  toJSON (ApplicationCommandOptionSubcommandOrGroupSubcommand ApplicationCommandOptionSubcommand
a) = ApplicationCommandOptionSubcommand -> Value
forall a. ToJSON a => a -> Value
toJSON ApplicationCommandOptionSubcommand
a

-- | Data for a single subcommand.
data ApplicationCommandOptionSubcommand = ApplicationCommandOptionSubcommand
  { -- | The name of the subcommand
    ApplicationCommandOptionSubcommand -> Text
applicationCommandOptionSubcommandName :: T.Text,
    -- | The description of the subcommand
    ApplicationCommandOptionSubcommand -> Text
applicationCommandOptionSubcommandDescription :: T.Text,
    -- | What options are there in this subcommand
    ApplicationCommandOptionSubcommand
-> [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandOptions :: [ApplicationCommandOptionValue]
  }
  deriving (Int -> ApplicationCommandOptionSubcommand -> ShowS
[ApplicationCommandOptionSubcommand] -> ShowS
ApplicationCommandOptionSubcommand -> String
(Int -> ApplicationCommandOptionSubcommand -> ShowS)
-> (ApplicationCommandOptionSubcommand -> String)
-> ([ApplicationCommandOptionSubcommand] -> ShowS)
-> Show ApplicationCommandOptionSubcommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptionSubcommand] -> ShowS
$cshowList :: [ApplicationCommandOptionSubcommand] -> ShowS
show :: ApplicationCommandOptionSubcommand -> String
$cshow :: ApplicationCommandOptionSubcommand -> String
showsPrec :: Int -> ApplicationCommandOptionSubcommand -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptionSubcommand -> ShowS
Show, ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
(ApplicationCommandOptionSubcommand
 -> ApplicationCommandOptionSubcommand -> Bool)
-> (ApplicationCommandOptionSubcommand
    -> ApplicationCommandOptionSubcommand -> Bool)
-> Eq ApplicationCommandOptionSubcommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
$c/= :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
== :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
$c== :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
Eq, ReadPrec [ApplicationCommandOptionSubcommand]
ReadPrec ApplicationCommandOptionSubcommand
Int -> ReadS ApplicationCommandOptionSubcommand
ReadS [ApplicationCommandOptionSubcommand]
(Int -> ReadS ApplicationCommandOptionSubcommand)
-> ReadS [ApplicationCommandOptionSubcommand]
-> ReadPrec ApplicationCommandOptionSubcommand
-> ReadPrec [ApplicationCommandOptionSubcommand]
-> Read ApplicationCommandOptionSubcommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptionSubcommand]
$creadListPrec :: ReadPrec [ApplicationCommandOptionSubcommand]
readPrec :: ReadPrec ApplicationCommandOptionSubcommand
$creadPrec :: ReadPrec ApplicationCommandOptionSubcommand
readList :: ReadS [ApplicationCommandOptionSubcommand]
$creadList :: ReadS [ApplicationCommandOptionSubcommand]
readsPrec :: Int -> ReadS ApplicationCommandOptionSubcommand
$creadsPrec :: Int -> ReadS ApplicationCommandOptionSubcommand
Read)

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

instance ToJSON ApplicationCommandOptionSubcommand where
  toJSON :: ApplicationCommandOptionSubcommand -> Value
toJSON ApplicationCommandOptionSubcommand {[ApplicationCommandOptionValue]
Text
applicationCommandOptionSubcommandOptions :: [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandDescription :: Text
applicationCommandOptionSubcommandName :: Text
applicationCommandOptionSubcommandOptions :: ApplicationCommandOptionSubcommand
-> [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandDescription :: ApplicationCommandOptionSubcommand -> Text
applicationCommandOptionSubcommandName :: ApplicationCommandOptionSubcommand -> Text
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
1),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionSubcommandName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionSubcommandDescription),
        (Key
"options", [ApplicationCommandOptionValue] -> Value
forall a. ToJSON a => a -> Value
toJSON [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandOptions)
      ]

-- | Data for a single value.
data ApplicationCommandOptionValue
  = ApplicationCommandOptionValueString
      { -- | The name of the value
        ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        ApplicationCommandOptionValue -> Text
applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        ApplicationCommandOptionValue -> Bool
applicationCommandOptionValueRequired :: Bool,
        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`
        ApplicationCommandOptionValue -> AutocompleteOrChoice Text
applicationCommandOptionValueStringChoices :: AutocompleteOrChoice T.Text
      }
  | ApplicationCommandOptionValueInteger
      { -- | The name of the value
        applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        applicationCommandOptionValueRequired :: Bool,
        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`
        ApplicationCommandOptionValue -> AutocompleteOrChoice Integer
applicationCommandOptionValueIntegerChoices :: AutocompleteOrChoice Integer,
        -- | The lower bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerMinVal :: Maybe Integer,
        -- | The upper bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerMaxVal :: Maybe Integer
      }
  | ApplicationCommandOptionValueBoolean
      { -- | The name of the value
        applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        applicationCommandOptionValueRequired :: Bool
      }
  | ApplicationCommandOptionValueUser
      { -- | The name of the value
        applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        applicationCommandOptionValueRequired :: Bool
      }
  | ApplicationCommandOptionValueChannel
      { -- | The name of the value
        applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        applicationCommandOptionValueRequired :: Bool,
        -- | What type of channel can be put in here
        ApplicationCommandOptionValue
-> Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueChannelTypes :: Maybe [ApplicationCommandChannelType]
      }
  | ApplicationCommandOptionValueRole
      { -- | The name of the value
        applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        applicationCommandOptionValueRequired :: Bool
      }
  | ApplicationCommandOptionValueMentionable
      { -- | The name of the value
        applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        applicationCommandOptionValueRequired :: Bool
      }
  | ApplicationCommandOptionValueNumber
      { -- | The name of the value
        applicationCommandOptionValueName :: T.Text,
        -- | The description of the value
        applicationCommandOptionValueDescription :: T.Text,
        -- | Whether this option is required
        applicationCommandOptionValueRequired :: Bool,
        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`
        ApplicationCommandOptionValue -> AutocompleteOrChoice Scientific
applicationCommandOptionValueNumberChoices :: AutocompleteOrChoice Scientific,
        -- | The lower bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberMinVal :: Maybe Scientific,
        -- | The upper bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberMaxVal :: Maybe Scientific
      }
  deriving (Int -> ApplicationCommandOptionValue -> ShowS
[ApplicationCommandOptionValue] -> ShowS
ApplicationCommandOptionValue -> String
(Int -> ApplicationCommandOptionValue -> ShowS)
-> (ApplicationCommandOptionValue -> String)
-> ([ApplicationCommandOptionValue] -> ShowS)
-> Show ApplicationCommandOptionValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptionValue] -> ShowS
$cshowList :: [ApplicationCommandOptionValue] -> ShowS
show :: ApplicationCommandOptionValue -> String
$cshow :: ApplicationCommandOptionValue -> String
showsPrec :: Int -> ApplicationCommandOptionValue -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptionValue -> ShowS
Show, ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
(ApplicationCommandOptionValue
 -> ApplicationCommandOptionValue -> Bool)
-> (ApplicationCommandOptionValue
    -> ApplicationCommandOptionValue -> Bool)
-> Eq ApplicationCommandOptionValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
$c/= :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
== :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
$c== :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
Eq, ReadPrec [ApplicationCommandOptionValue]
ReadPrec ApplicationCommandOptionValue
Int -> ReadS ApplicationCommandOptionValue
ReadS [ApplicationCommandOptionValue]
(Int -> ReadS ApplicationCommandOptionValue)
-> ReadS [ApplicationCommandOptionValue]
-> ReadPrec ApplicationCommandOptionValue
-> ReadPrec [ApplicationCommandOptionValue]
-> Read ApplicationCommandOptionValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptionValue]
$creadListPrec :: ReadPrec [ApplicationCommandOptionValue]
readPrec :: ReadPrec ApplicationCommandOptionValue
$creadPrec :: ReadPrec ApplicationCommandOptionValue
readList :: ReadS [ApplicationCommandOptionValue]
$creadList :: ReadS [ApplicationCommandOptionValue]
readsPrec :: Int -> ReadS ApplicationCommandOptionValue
$creadsPrec :: Int -> ReadS ApplicationCommandOptionValue
Read)

instance FromJSON ApplicationCommandOptionValue where
  parseJSON :: Value -> Parser ApplicationCommandOptionValue
parseJSON =
    String
-> (Object -> Parser ApplicationCommandOptionValue)
-> Value
-> Parser ApplicationCommandOptionValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommandOptionValue"
      ( \Object
v -> do
          Text
name <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Text
desc <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
          Bool
required <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
3 ->
              Text
-> Text
-> Bool
-> AutocompleteOrChoice Text
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueString Text
name Text
desc Bool
required
                (AutocompleteOrChoice Text -> ApplicationCommandOptionValue)
-> Parser (AutocompleteOrChoice Text)
-> Parser ApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (AutocompleteOrChoice Text)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Int
4 ->
              Text
-> Text
-> Bool
-> AutocompleteOrChoice Integer
-> Maybe Integer
-> Maybe Integer
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueInteger Text
name Text
desc Bool
required
                (AutocompleteOrChoice Integer
 -> Maybe Integer -> Maybe Integer -> ApplicationCommandOptionValue)
-> Parser (AutocompleteOrChoice Integer)
-> Parser
     (Maybe Integer -> Maybe Integer -> ApplicationCommandOptionValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (AutocompleteOrChoice Integer)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (Maybe Integer -> Maybe Integer -> ApplicationCommandOptionValue)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> ApplicationCommandOptionValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_value"
                Parser (Maybe Integer -> ApplicationCommandOptionValue)
-> Parser (Maybe Integer) -> Parser ApplicationCommandOptionValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_value"
            Int
10 ->
              Text
-> Text
-> Bool
-> AutocompleteOrChoice Scientific
-> Maybe Scientific
-> Maybe Scientific
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueNumber Text
name Text
desc Bool
required
                (AutocompleteOrChoice Scientific
 -> Maybe Scientific
 -> Maybe Scientific
 -> ApplicationCommandOptionValue)
-> Parser (AutocompleteOrChoice Scientific)
-> Parser
     (Maybe Scientific
      -> Maybe Scientific -> ApplicationCommandOptionValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (AutocompleteOrChoice Scientific)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (Maybe Scientific
   -> Maybe Scientific -> ApplicationCommandOptionValue)
-> Parser (Maybe Scientific)
-> Parser (Maybe Scientific -> ApplicationCommandOptionValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_value"
                Parser (Maybe Scientific -> ApplicationCommandOptionValue)
-> Parser (Maybe Scientific)
-> Parser ApplicationCommandOptionValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_value"
            Int
7 ->
              Text
-> Text
-> Bool
-> Maybe [ApplicationCommandChannelType]
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueChannel Text
name Text
desc Bool
required
                (Maybe [ApplicationCommandChannelType]
 -> ApplicationCommandOptionValue)
-> Parser (Maybe [ApplicationCommandChannelType])
-> Parser ApplicationCommandOptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe [ApplicationCommandChannelType])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_types"
            Int
5 -> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionValue
 -> Parser ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueBoolean Text
name Text
desc Bool
required
            Int
6 -> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionValue
 -> Parser ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueUser Text
name Text
desc Bool
required
            Int
8 -> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionValue
 -> Parser ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueRole Text
name Text
desc Bool
required
            Int
9 -> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionValue
 -> Parser ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Parser ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueMentionable Text
name Text
desc Bool
required
            Int
_ -> String -> Parser ApplicationCommandOptionValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown application command option value type"
      )

instance ToJSON ApplicationCommandOptionValue where
  toJSON :: ApplicationCommandOptionValue -> Value
toJSON ApplicationCommandOptionValueString {Bool
AutocompleteOrChoice Text
Text
applicationCommandOptionValueStringChoices :: AutocompleteOrChoice Text
applicationCommandOptionValueRequired :: Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueStringChoices :: ApplicationCommandOptionValue -> AutocompleteOrChoice Text
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
3),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
applicationCommandOptionValueRequired),
        AutocompleteOrChoice Text -> Pair
forall a. ToJSON a => AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON AutocompleteOrChoice Text
applicationCommandOptionValueStringChoices
      ]
  toJSON ApplicationCommandOptionValueInteger {Bool
Maybe Integer
AutocompleteOrChoice Integer
Text
applicationCommandOptionValueIntegerMaxVal :: Maybe Integer
applicationCommandOptionValueIntegerMinVal :: Maybe Integer
applicationCommandOptionValueIntegerChoices :: AutocompleteOrChoice Integer
applicationCommandOptionValueRequired :: Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueIntegerMaxVal :: ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerMinVal :: ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerChoices :: ApplicationCommandOptionValue -> AutocompleteOrChoice Integer
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
4),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
applicationCommandOptionValueRequired),
        AutocompleteOrChoice Integer -> Pair
forall a. ToJSON a => AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON AutocompleteOrChoice Integer
applicationCommandOptionValueIntegerChoices
      ]
  toJSON ApplicationCommandOptionValueNumber {Bool
Maybe Scientific
AutocompleteOrChoice Scientific
Text
applicationCommandOptionValueNumberMaxVal :: Maybe Scientific
applicationCommandOptionValueNumberMinVal :: Maybe Scientific
applicationCommandOptionValueNumberChoices :: AutocompleteOrChoice Scientific
applicationCommandOptionValueRequired :: Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueNumberMaxVal :: ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberMinVal :: ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberChoices :: ApplicationCommandOptionValue -> AutocompleteOrChoice Scientific
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
10),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
applicationCommandOptionValueRequired),
        AutocompleteOrChoice Scientific -> Pair
forall a. ToJSON a => AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON AutocompleteOrChoice Scientific
applicationCommandOptionValueNumberChoices
      ]
  toJSON ApplicationCommandOptionValueChannel {Bool
Maybe [ApplicationCommandChannelType]
Text
applicationCommandOptionValueChannelTypes :: Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueRequired :: Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueChannelTypes :: ApplicationCommandOptionValue
-> Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
7),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
applicationCommandOptionValueDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
applicationCommandOptionValueRequired),
        (Key
"channel_types", Maybe [ApplicationCommandChannelType] -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueChannelTypes)
      ]
  toJSON ApplicationCommandOptionValue
acov =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number (ApplicationCommandOptionValue -> Scientific
forall p. Num p => ApplicationCommandOptionValue -> p
t ApplicationCommandOptionValue
acov)),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName ApplicationCommandOptionValue
acov),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ApplicationCommandOptionValue -> Text
applicationCommandOptionValueDescription ApplicationCommandOptionValue
acov),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ ApplicationCommandOptionValue -> Bool
applicationCommandOptionValueRequired ApplicationCommandOptionValue
acov)
      ]
    where
      t :: ApplicationCommandOptionValue -> p
t ApplicationCommandOptionValueBoolean {} = p
5
      t ApplicationCommandOptionValueUser {} = p
6
      t ApplicationCommandOptionValueRole {} = p
8
      t ApplicationCommandOptionValueMentionable {} = p
9
      t ApplicationCommandOptionValue
_ = -p
1

-- | Data type to be used when creating application commands. The specification
-- is below.
--
-- If a command of the same type and and name is sent to the server, it will
-- overwrite any command that already exists in the same scope (guild vs
-- global).
--
-- The description has to be empty for non-slash command application
-- commands, as do the options. The options need to be `Nothing` for non-slash
-- commands, too. If one of the options is a subcommand or subcommand group,
-- the base command will no longer be usable.
--
-- A subcommand group can have subcommands within it. This is the maximum amount
-- of command nesting permitted.
--
-- https://discord.com/developers/docs/interactions/application-commands#create-global-application-command
data CreateApplicationCommand
  = CreateApplicationCommandChatInput
      { -- | The application command name (1-32 chars).
        CreateApplicationCommand -> Text
createApplicationCommandName :: T.Text,
        -- | The application command description (1-100 chars). Has to be empty for
        -- non-slash commands.
        CreateApplicationCommand -> Text
createApplicationCommandDescription :: T.Text,
        -- | What options the application (max length 25). Has to be `Nothing` for
        -- non-slash commands.
        CreateApplicationCommand -> Maybe ApplicationCommandOptions
createApplicationCommandOptions :: Maybe ApplicationCommandOptions,
        -- | Whether the command is enabled by default when the application is added
        -- to a guild.
        CreateApplicationCommand -> Bool
createApplicationCommandDefaultPermission :: Bool
      }
  | CreateApplicationCommandUser
      { -- | The application command name (1-32 chars).
        createApplicationCommandName :: T.Text,
        -- | Whether the command is enabled by default when the application is added
        -- to a guild.
        createApplicationCommandDefaultPermission :: Bool
      }
  | CreateApplicationCommandMessage
      { -- | The application command name (1-32 chars).
        createApplicationCommandName :: T.Text,
        -- | Whether the command is enabled by default when the application is added
        -- to a guild.
        createApplicationCommandDefaultPermission :: Bool
      }
  deriving (Int -> CreateApplicationCommand -> ShowS
[CreateApplicationCommand] -> ShowS
CreateApplicationCommand -> String
(Int -> CreateApplicationCommand -> ShowS)
-> (CreateApplicationCommand -> String)
-> ([CreateApplicationCommand] -> ShowS)
-> Show CreateApplicationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplicationCommand] -> ShowS
$cshowList :: [CreateApplicationCommand] -> ShowS
show :: CreateApplicationCommand -> String
$cshow :: CreateApplicationCommand -> String
showsPrec :: Int -> CreateApplicationCommand -> ShowS
$cshowsPrec :: Int -> CreateApplicationCommand -> ShowS
Show, CreateApplicationCommand -> CreateApplicationCommand -> Bool
(CreateApplicationCommand -> CreateApplicationCommand -> Bool)
-> (CreateApplicationCommand -> CreateApplicationCommand -> Bool)
-> Eq CreateApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
$c/= :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
== :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
$c== :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
Eq, ReadPrec [CreateApplicationCommand]
ReadPrec CreateApplicationCommand
Int -> ReadS CreateApplicationCommand
ReadS [CreateApplicationCommand]
(Int -> ReadS CreateApplicationCommand)
-> ReadS [CreateApplicationCommand]
-> ReadPrec CreateApplicationCommand
-> ReadPrec [CreateApplicationCommand]
-> Read CreateApplicationCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplicationCommand]
$creadListPrec :: ReadPrec [CreateApplicationCommand]
readPrec :: ReadPrec CreateApplicationCommand
$creadPrec :: ReadPrec CreateApplicationCommand
readList :: ReadS [CreateApplicationCommand]
$creadList :: ReadS [CreateApplicationCommand]
readsPrec :: Int -> ReadS CreateApplicationCommand
$creadsPrec :: Int -> ReadS CreateApplicationCommand
Read)

instance ToJSON CreateApplicationCommand where
  toJSON :: CreateApplicationCommand -> Value
toJSON CreateApplicationCommandChatInput {Bool
Maybe ApplicationCommandOptions
Text
createApplicationCommandDefaultPermission :: Bool
createApplicationCommandOptions :: Maybe ApplicationCommandOptions
createApplicationCommandDescription :: Text
createApplicationCommandName :: Text
createApplicationCommandDefaultPermission :: CreateApplicationCommand -> Bool
createApplicationCommandOptions :: CreateApplicationCommand -> Maybe ApplicationCommandOptions
createApplicationCommandDescription :: CreateApplicationCommand -> Text
createApplicationCommandName :: CreateApplicationCommand -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
createApplicationCommandName),
              (Key
"description", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
createApplicationCommandDescription),
              (Key
"options", ApplicationCommandOptions -> Value
forall a. ToJSON a => a -> Value
toJSON (ApplicationCommandOptions -> Value)
-> Maybe ApplicationCommandOptions -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ApplicationCommandOptions
createApplicationCommandOptions),
              (Key
"default_permission", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
createApplicationCommandDefaultPermission),
              (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
1)
            ]
      ]
  toJSON CreateApplicationCommandUser {Bool
Text
createApplicationCommandDefaultPermission :: Bool
createApplicationCommandName :: Text
createApplicationCommandDefaultPermission :: CreateApplicationCommand -> Bool
createApplicationCommandName :: CreateApplicationCommand -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
createApplicationCommandName),
              (Key
"default_permission", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
createApplicationCommandDefaultPermission),
              (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
2)
            ]
      ]
  toJSON CreateApplicationCommandMessage {Bool
Text
createApplicationCommandDefaultPermission :: Bool
createApplicationCommandName :: Text
createApplicationCommandDefaultPermission :: CreateApplicationCommand -> Bool
createApplicationCommandName :: CreateApplicationCommand -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
createApplicationCommandName),
              (Key
"default_permission", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
createApplicationCommandDefaultPermission),
              (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
3)
            ]
      ]

nameIsValid :: Bool -> T.Text -> Bool
nameIsValid :: Bool -> Text -> Bool
nameIsValid Bool
isChatInput Text
name = Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 Bool -> Bool -> Bool
&& (Bool
isChatInput Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
<= (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
validChars) Text
name)
  where
    l :: Int
l = Text -> Int
T.length Text
name
    validChars :: String
validChars = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char
'a' .. Char
'z']

-- | Create the basics for a chat input (slash command). Use record overwriting
-- to enter the other values. The name needs to be all lower case letters, and
-- between 1 and 32 characters. The description has to be non-empty and less
-- than or equal to 100 characters.
createApplicationCommandChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand
createApplicationCommandChatInput :: Text -> Text -> Maybe CreateApplicationCommand
createApplicationCommandChatInput Text
name Text
desc
  | Bool -> Text -> Bool
nameIsValid Bool
True Text
name Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
desc) Bool -> Bool -> Bool
&& Text -> Int
T.length Text
desc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 = CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a. a -> Maybe a
Just (CreateApplicationCommand -> Maybe CreateApplicationCommand)
-> CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe ApplicationCommandOptions
-> Bool
-> CreateApplicationCommand
CreateApplicationCommandChatInput Text
name Text
desc Maybe ApplicationCommandOptions
forall a. Maybe a
Nothing Bool
True
  | Bool
otherwise = Maybe CreateApplicationCommand
forall a. Maybe a
Nothing

-- | Create the basics for a user command. Use record overwriting to enter the
-- other values. The name needs to be between 1 and 32 characters.
createApplicationCommandUser :: T.Text -> Maybe CreateApplicationCommand
createApplicationCommandUser :: Text -> Maybe CreateApplicationCommand
createApplicationCommandUser Text
name
  | Bool -> Text -> Bool
nameIsValid Bool
False Text
name = CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a. a -> Maybe a
Just (CreateApplicationCommand -> Maybe CreateApplicationCommand)
-> CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> CreateApplicationCommand
CreateApplicationCommandUser Text
name Bool
True
  | Bool
otherwise = Maybe CreateApplicationCommand
forall a. Maybe a
Nothing

-- | Create the basics for a message command. Use record overwriting to enter
-- the other values. The name needs to be between 1 and 32 characters.
createApplicationCommandMessage :: T.Text -> Maybe CreateApplicationCommand
createApplicationCommandMessage :: Text -> Maybe CreateApplicationCommand
createApplicationCommandMessage Text
name
  | Bool -> Text -> Bool
nameIsValid Bool
False Text
name = CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a. a -> Maybe a
Just (CreateApplicationCommand -> Maybe CreateApplicationCommand)
-> CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> CreateApplicationCommand
CreateApplicationCommandMessage Text
name Bool
True
  | Bool
otherwise = Maybe CreateApplicationCommand
forall a. Maybe a
Nothing

-- | Data type to be used when editing application commands. The specification
-- is below. See `CreateApplicationCommand` for an explanation for the
-- parameters.
--
-- https://discord.com/developers/docs/interactions/application-commands#edit-global-application-command
data EditApplicationCommand
  = EditApplicationCommandChatInput
      { EditApplicationCommand -> Maybe Text
editApplicationCommandName :: Maybe T.Text,
        EditApplicationCommand -> Maybe Text
editApplicationCommandDescription :: Maybe T.Text,
        EditApplicationCommand -> Maybe ApplicationCommandOptions
editApplicationCommandOptions :: Maybe ApplicationCommandOptions,
        EditApplicationCommand -> Maybe Bool
editApplicationCommandDefaultPermission :: Maybe Bool
      }
  | EditApplicationCommandUser
      { editApplicationCommandName :: Maybe T.Text,
        editApplicationCommandDefaultPermission :: Maybe Bool
      }
  | EditApplicationCommandMessage
      { editApplicationCommandName :: Maybe T.Text,
        editApplicationCommandDefaultPermission :: Maybe Bool
      }

defaultEditApplicationCommand :: Int -> EditApplicationCommand
defaultEditApplicationCommand :: Int -> EditApplicationCommand
defaultEditApplicationCommand Int
2 = Maybe Text -> Maybe Bool -> EditApplicationCommand
EditApplicationCommandUser Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
defaultEditApplicationCommand Int
3 = Maybe Text -> Maybe Bool -> EditApplicationCommand
EditApplicationCommandMessage Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
defaultEditApplicationCommand Int
_ = Maybe Text
-> Maybe Text
-> Maybe ApplicationCommandOptions
-> Maybe Bool
-> EditApplicationCommand
EditApplicationCommandChatInput Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe ApplicationCommandOptions
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

instance ToJSON EditApplicationCommand where
  toJSON :: EditApplicationCommand -> Value
toJSON EditApplicationCommandChatInput {Maybe Bool
Maybe Text
Maybe ApplicationCommandOptions
editApplicationCommandDefaultPermission :: Maybe Bool
editApplicationCommandOptions :: Maybe ApplicationCommandOptions
editApplicationCommandDescription :: Maybe Text
editApplicationCommandName :: Maybe Text
editApplicationCommandDefaultPermission :: EditApplicationCommand -> Maybe Bool
editApplicationCommandOptions :: EditApplicationCommand -> Maybe ApplicationCommandOptions
editApplicationCommandDescription :: EditApplicationCommand -> Maybe Text
editApplicationCommandName :: EditApplicationCommand -> Maybe Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", 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
editApplicationCommandName),
              (Key
"description", 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
editApplicationCommandDescription),
              (Key
"options", ApplicationCommandOptions -> Value
forall a. ToJSON a => a -> Value
toJSON (ApplicationCommandOptions -> Value)
-> Maybe ApplicationCommandOptions -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ApplicationCommandOptions
editApplicationCommandOptions),
              (Key
"default_permission", 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
editApplicationCommandDefaultPermission),
              (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
1)
            ]
      ]
  toJSON EditApplicationCommandUser {Maybe Bool
Maybe Text
editApplicationCommandDefaultPermission :: Maybe Bool
editApplicationCommandName :: Maybe Text
editApplicationCommandDefaultPermission :: EditApplicationCommand -> Maybe Bool
editApplicationCommandName :: EditApplicationCommand -> Maybe Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", 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
editApplicationCommandName),
              (Key
"default_permission", 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
editApplicationCommandDefaultPermission),
              (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
2)
            ]
      ]
  toJSON EditApplicationCommandMessage {Maybe Bool
Maybe Text
editApplicationCommandDefaultPermission :: Maybe Bool
editApplicationCommandName :: Maybe Text
editApplicationCommandDefaultPermission :: EditApplicationCommand -> Maybe Bool
editApplicationCommandName :: EditApplicationCommand -> Maybe Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", 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
editApplicationCommandName),
              (Key
"default_permission", 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
editApplicationCommandDefaultPermission),
              (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
3)
            ]
      ]

data Choice a = Choice {Choice a -> Text
choiceName :: T.Text, Choice a -> a
choiceValue :: a}
  deriving (Int -> Choice a -> ShowS
[Choice a] -> ShowS
Choice a -> String
(Int -> Choice a -> ShowS)
-> (Choice a -> String) -> ([Choice a] -> ShowS) -> Show (Choice a)
forall a. Show a => Int -> Choice a -> ShowS
forall a. Show a => [Choice a] -> ShowS
forall a. Show a => Choice a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Choice a] -> ShowS
$cshowList :: forall a. Show a => [Choice a] -> ShowS
show :: Choice a -> String
$cshow :: forall a. Show a => Choice a -> String
showsPrec :: Int -> Choice a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Choice a -> ShowS
Show, ReadPrec [Choice a]
ReadPrec (Choice a)
Int -> ReadS (Choice a)
ReadS [Choice a]
(Int -> ReadS (Choice a))
-> ReadS [Choice a]
-> ReadPrec (Choice a)
-> ReadPrec [Choice a]
-> Read (Choice a)
forall a. Read a => ReadPrec [Choice a]
forall a. Read a => ReadPrec (Choice a)
forall a. Read a => Int -> ReadS (Choice a)
forall a. Read a => ReadS [Choice a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Choice a]
$creadListPrec :: forall a. Read a => ReadPrec [Choice a]
readPrec :: ReadPrec (Choice a)
$creadPrec :: forall a. Read a => ReadPrec (Choice a)
readList :: ReadS [Choice a]
$creadList :: forall a. Read a => ReadS [Choice a]
readsPrec :: Int -> ReadS (Choice a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Choice a)
Read, Choice a -> Choice a -> Bool
(Choice a -> Choice a -> Bool)
-> (Choice a -> Choice a -> Bool) -> Eq (Choice a)
forall a. Eq a => Choice a -> Choice a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Choice a -> Choice a -> Bool
$c/= :: forall a. Eq a => Choice a -> Choice a -> Bool
== :: Choice a -> Choice a -> Bool
$c== :: forall a. Eq a => Choice a -> Choice a -> Bool
Eq)

instance Functor Choice where
  fmap :: (a -> b) -> Choice a -> Choice b
fmap a -> b
f (Choice Text
s a
a) = Text -> b -> Choice b
forall a. Text -> a -> Choice a
Choice Text
s (a -> b
f a
a)

instance (ToJSON a) => ToJSON (Choice a) where
  toJSON :: Choice a -> Value
toJSON Choice {a
Text
choiceValue :: a
choiceName :: Text
choiceValue :: forall a. Choice a -> a
choiceName :: forall a. Choice a -> Text
..} = [Pair] -> Value
object [(Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
choiceName), (Key
"value", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
choiceValue)]

instance (FromJSON a) => FromJSON (Choice a) where
  parseJSON :: Value -> Parser (Choice a)
parseJSON =
    String
-> (Object -> Parser (Choice a)) -> Value -> Parser (Choice a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"Choice"
      ( \Object
v ->
          Text -> a -> Choice a
forall a. Text -> a -> Choice a
Choice
            (Text -> a -> Choice a) -> Parser Text -> Parser (a -> Choice a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Parser (a -> Choice a) -> Parser a -> Parser (Choice a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      )

type AutocompleteOrChoice a = Either Bool [Choice a]

instance {-# OVERLAPPING #-} (FromJSON a) => FromJSON (AutocompleteOrChoice a) where
  parseJSON :: Value -> Parser (AutocompleteOrChoice a)
parseJSON =
    String
-> (Object -> Parser (AutocompleteOrChoice a))
-> Value
-> Parser (AutocompleteOrChoice a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"AutocompleteOrChoice"
      ( \Object
v -> do
          Maybe [Choice a]
mcs <- Object
v Object -> Key -> Parser (Maybe [Choice a])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"choices"
          case Maybe [Choice a]
mcs of
            Maybe [Choice a]
Nothing -> Bool -> AutocompleteOrChoice a
forall a b. a -> Either a b
Left (Bool -> AutocompleteOrChoice a)
-> Parser Bool -> Parser (AutocompleteOrChoice a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"autocomplete" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Just [Choice a]
cs -> AutocompleteOrChoice a -> Parser (AutocompleteOrChoice a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AutocompleteOrChoice a -> Parser (AutocompleteOrChoice a))
-> AutocompleteOrChoice a -> Parser (AutocompleteOrChoice a)
forall a b. (a -> b) -> a -> b
$ [Choice a] -> AutocompleteOrChoice a
forall a b. b -> Either a b
Right [Choice a]
cs
      )

choiceOrAutocompleteToJSON :: (ToJSON a) => AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON :: AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON (Left Bool
b) = (Key
"autocomplete", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b)
choiceOrAutocompleteToJSON (Right [Choice a]
cs) = (Key
"choices", [Choice a] -> Value
forall a. ToJSON a => a -> Value
toJSON [Choice a]
cs)

-- | The different channel types.
--
-- https://discord.com/developers/docs/resources/channel#channel-object-channel-types
data ApplicationCommandChannelType
  = -- | A text channel in a server.
    ApplicationCommandChannelTypeGuildText
  | -- | A direct message between users.
    ApplicationCommandChannelTypeDM
  | -- | A voice channel in a server.
    ApplicationCommandChannelTypeGuildVoice
  | -- | A direct message between multiple users.
    ApplicationCommandChannelTypeGroupDM
  | -- | An organizational category that contains up to 50 channels.
    ApplicationCommandChannelTypeGuildCategory
  | -- | A channel that users can follow and crosspost into their own server.
    ApplicationCommandChannelTypeGuildNews
  | -- | A channel in which game developers can sell their game on discord.
    ApplicationCommandChannelTypeGuildStore
  | -- | A temporary sub-channel within a guild_news channel.
    ApplicationCommandChannelTypeGuildNewsThread
  | -- | A temporary sub-channel within a guild_text channel.
    ApplicationCommandChannelTypeGuildPublicThread
  | -- | A temporary sub-channel within a GUILD_TEXT channel that is only
    -- viewable by those invited and those with the MANAGE_THREADS permission
    ApplicationCommandChannelTypeGuildPrivateThread
  | -- | A voice channel for hosting events with an audience.
    ApplicationCommandChannelTypeGuildStageVoice
  deriving (Int -> ApplicationCommandChannelType -> ShowS
[ApplicationCommandChannelType] -> ShowS
ApplicationCommandChannelType -> String
(Int -> ApplicationCommandChannelType -> ShowS)
-> (ApplicationCommandChannelType -> String)
-> ([ApplicationCommandChannelType] -> ShowS)
-> Show ApplicationCommandChannelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandChannelType] -> ShowS
$cshowList :: [ApplicationCommandChannelType] -> ShowS
show :: ApplicationCommandChannelType -> String
$cshow :: ApplicationCommandChannelType -> String
showsPrec :: Int -> ApplicationCommandChannelType -> ShowS
$cshowsPrec :: Int -> ApplicationCommandChannelType -> ShowS
Show, ReadPrec [ApplicationCommandChannelType]
ReadPrec ApplicationCommandChannelType
Int -> ReadS ApplicationCommandChannelType
ReadS [ApplicationCommandChannelType]
(Int -> ReadS ApplicationCommandChannelType)
-> ReadS [ApplicationCommandChannelType]
-> ReadPrec ApplicationCommandChannelType
-> ReadPrec [ApplicationCommandChannelType]
-> Read ApplicationCommandChannelType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandChannelType]
$creadListPrec :: ReadPrec [ApplicationCommandChannelType]
readPrec :: ReadPrec ApplicationCommandChannelType
$creadPrec :: ReadPrec ApplicationCommandChannelType
readList :: ReadS [ApplicationCommandChannelType]
$creadList :: ReadS [ApplicationCommandChannelType]
readsPrec :: Int -> ReadS ApplicationCommandChannelType
$creadsPrec :: Int -> ReadS ApplicationCommandChannelType
Read, Typeable ApplicationCommandChannelType
DataType
Constr
Typeable ApplicationCommandChannelType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ApplicationCommandChannelType
    -> c ApplicationCommandChannelType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ApplicationCommandChannelType)
-> (ApplicationCommandChannelType -> Constr)
-> (ApplicationCommandChannelType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ApplicationCommandChannelType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ApplicationCommandChannelType))
-> ((forall b. Data b => b -> b)
    -> ApplicationCommandChannelType -> ApplicationCommandChannelType)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandChannelType
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandChannelType
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ApplicationCommandChannelType -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ApplicationCommandChannelType
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandChannelType
    -> m ApplicationCommandChannelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandChannelType
    -> m ApplicationCommandChannelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandChannelType
    -> m ApplicationCommandChannelType)
-> Data ApplicationCommandChannelType
ApplicationCommandChannelType -> DataType
ApplicationCommandChannelType -> Constr
(forall b. Data b => b -> b)
-> ApplicationCommandChannelType -> ApplicationCommandChannelType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandChannelType
-> u
forall u.
(forall d. Data d => d -> u)
-> ApplicationCommandChannelType -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandChannelType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandChannelType)
$cApplicationCommandChannelTypeGuildStageVoice :: Constr
$cApplicationCommandChannelTypeGuildPrivateThread :: Constr
$cApplicationCommandChannelTypeGuildPublicThread :: Constr
$cApplicationCommandChannelTypeGuildNewsThread :: Constr
$cApplicationCommandChannelTypeGuildStore :: Constr
$cApplicationCommandChannelTypeGuildNews :: Constr
$cApplicationCommandChannelTypeGuildCategory :: Constr
$cApplicationCommandChannelTypeGroupDM :: Constr
$cApplicationCommandChannelTypeGuildVoice :: Constr
$cApplicationCommandChannelTypeDM :: Constr
$cApplicationCommandChannelTypeGuildText :: Constr
$tApplicationCommandChannelType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
gmapMp :: (forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
gmapM :: (forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandChannelType
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandChannelType
-> u
gmapQ :: (forall d. Data d => d -> u)
-> ApplicationCommandChannelType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ApplicationCommandChannelType -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
gmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandChannelType -> ApplicationCommandChannelType
$cgmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandChannelType -> ApplicationCommandChannelType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandChannelType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandChannelType)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandChannelType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandChannelType)
dataTypeOf :: ApplicationCommandChannelType -> DataType
$cdataTypeOf :: ApplicationCommandChannelType -> DataType
toConstr :: ApplicationCommandChannelType -> Constr
$ctoConstr :: ApplicationCommandChannelType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
$cp1Data :: Typeable ApplicationCommandChannelType
Data, ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
(ApplicationCommandChannelType
 -> ApplicationCommandChannelType -> Bool)
-> (ApplicationCommandChannelType
    -> ApplicationCommandChannelType -> Bool)
-> Eq ApplicationCommandChannelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
$c/= :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
== :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
$c== :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
Eq)

instance InternalDiscordEnum ApplicationCommandChannelType where
  discordTypeStartValue :: ApplicationCommandChannelType
discordTypeStartValue = ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildText
  fromDiscordType :: ApplicationCommandChannelType -> Int
fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildText = Int
0
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeDM = Int
1
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildVoice = Int
2
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGroupDM = Int
3
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildCategory = Int
4
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildNews = Int
5
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildStore = Int
6
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildNewsThread = Int
10
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildPublicThread = Int
11
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildPrivateThread = Int
12
  fromDiscordType ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildStageVoice = Int
13

instance ToJSON ApplicationCommandChannelType where
  toJSON :: ApplicationCommandChannelType -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value)
-> (ApplicationCommandChannelType -> Int)
-> ApplicationCommandChannelType
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationCommandChannelType -> Int
forall a. InternalDiscordEnum a => a -> Int
fromDiscordType

instance FromJSON ApplicationCommandChannelType where
  parseJSON :: Value -> Parser ApplicationCommandChannelType
parseJSON = String -> Value -> Parser ApplicationCommandChannelType
forall a. InternalDiscordEnum a => String -> Value -> Parser a
discordTypeParseJSON String
"ApplicationCommandChannelType"

data GuildApplicationCommandPermissions = GuildApplicationCommandPermissions
  { -- | The id of the command.
    GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsId :: ApplicationCommandId,
    -- | The id of the application.
    GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: ApplicationId,
    -- | The id of the guild.
    GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsGuildId :: GuildId,
    -- | The permissions for the command in the guild.
    GuildApplicationCommandPermissions
-> [ApplicationCommandPermissions]
guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]
  }
  deriving (Int -> GuildApplicationCommandPermissions -> ShowS
[GuildApplicationCommandPermissions] -> ShowS
GuildApplicationCommandPermissions -> String
(Int -> GuildApplicationCommandPermissions -> ShowS)
-> (GuildApplicationCommandPermissions -> String)
-> ([GuildApplicationCommandPermissions] -> ShowS)
-> Show GuildApplicationCommandPermissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildApplicationCommandPermissions] -> ShowS
$cshowList :: [GuildApplicationCommandPermissions] -> ShowS
show :: GuildApplicationCommandPermissions -> String
$cshow :: GuildApplicationCommandPermissions -> String
showsPrec :: Int -> GuildApplicationCommandPermissions -> ShowS
$cshowsPrec :: Int -> GuildApplicationCommandPermissions -> ShowS
Show, GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
(GuildApplicationCommandPermissions
 -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> Eq GuildApplicationCommandPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c/= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
== :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c== :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
Eq, Eq GuildApplicationCommandPermissions
Eq GuildApplicationCommandPermissions
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Ordering)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions)
-> Ord GuildApplicationCommandPermissions
GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Ordering
GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
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 :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
$cmin :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
max :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
$cmax :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
>= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c>= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
> :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c> :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
<= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c<= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
< :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c< :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
compare :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Ordering
$ccompare :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Ordering
$cp1Ord :: Eq GuildApplicationCommandPermissions
Ord, ReadPrec [GuildApplicationCommandPermissions]
ReadPrec GuildApplicationCommandPermissions
Int -> ReadS GuildApplicationCommandPermissions
ReadS [GuildApplicationCommandPermissions]
(Int -> ReadS GuildApplicationCommandPermissions)
-> ReadS [GuildApplicationCommandPermissions]
-> ReadPrec GuildApplicationCommandPermissions
-> ReadPrec [GuildApplicationCommandPermissions]
-> Read GuildApplicationCommandPermissions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GuildApplicationCommandPermissions]
$creadListPrec :: ReadPrec [GuildApplicationCommandPermissions]
readPrec :: ReadPrec GuildApplicationCommandPermissions
$creadPrec :: ReadPrec GuildApplicationCommandPermissions
readList :: ReadS [GuildApplicationCommandPermissions]
$creadList :: ReadS [GuildApplicationCommandPermissions]
readsPrec :: Int -> ReadS GuildApplicationCommandPermissions
$creadsPrec :: Int -> ReadS GuildApplicationCommandPermissions
Read)

instance FromJSON GuildApplicationCommandPermissions where
  parseJSON :: Value -> Parser GuildApplicationCommandPermissions
parseJSON =
    String
-> (Object -> Parser GuildApplicationCommandPermissions)
-> Value
-> Parser GuildApplicationCommandPermissions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"GuildApplicationCommandPermissions"
      ( \Object
v ->
          ApplicationCommandId
-> ApplicationCommandId
-> ApplicationCommandId
-> [ApplicationCommandPermissions]
-> GuildApplicationCommandPermissions
GuildApplicationCommandPermissions
            (ApplicationCommandId
 -> ApplicationCommandId
 -> ApplicationCommandId
 -> [ApplicationCommandPermissions]
 -> GuildApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     (ApplicationCommandId
      -> ApplicationCommandId
      -> [ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser
  (ApplicationCommandId
   -> ApplicationCommandId
   -> [ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     (ApplicationCommandId
      -> [ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
            Parser
  (ApplicationCommandId
   -> [ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     ([ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
            Parser
  ([ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser [ApplicationCommandPermissions]
-> Parser GuildApplicationCommandPermissions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [ApplicationCommandPermissions]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permissions"
      )

instance ToJSON GuildApplicationCommandPermissions where
  toJSON :: GuildApplicationCommandPermissions -> Value
toJSON GuildApplicationCommandPermissions {[ApplicationCommandPermissions]
ApplicationCommandId
guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]
guildApplicationCommandPermissionsGuildId :: ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: ApplicationCommandId
guildApplicationCommandPermissionsId :: ApplicationCommandId
guildApplicationCommandPermissionsPermissions :: GuildApplicationCommandPermissions
-> [ApplicationCommandPermissions]
guildApplicationCommandPermissionsGuildId :: GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsId :: GuildApplicationCommandPermissions -> ApplicationCommandId
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
guildApplicationCommandPermissionsId),
              (Key
"application_id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
guildApplicationCommandPermissionsApplicationId),
              (Key
"guild_id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
guildApplicationCommandPermissionsGuildId),
              (Key
"permissions", [ApplicationCommandPermissions] -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON [ApplicationCommandPermissions]
guildApplicationCommandPermissionsPermissions)
            ]
      ]

-- | Application command permissions allow you to enable or disable commands for
-- specific users or roles within a guild.
data ApplicationCommandPermissions = ApplicationCommandPermissions
  { -- | The id of the role or user.
    ApplicationCommandPermissions -> ApplicationCommandId
applicationCommandPermissionsId :: Snowflake,
    -- | Choose either role (1) or user (2).
    ApplicationCommandPermissions -> Integer
applicationCommandPermissionsType :: Integer,
    -- | Whether to allow or not.
    ApplicationCommandPermissions -> Bool
applicationCommandPermissionsPermission :: Bool
  }
  deriving (Int -> ApplicationCommandPermissions -> ShowS
[ApplicationCommandPermissions] -> ShowS
ApplicationCommandPermissions -> String
(Int -> ApplicationCommandPermissions -> ShowS)
-> (ApplicationCommandPermissions -> String)
-> ([ApplicationCommandPermissions] -> ShowS)
-> Show ApplicationCommandPermissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandPermissions] -> ShowS
$cshowList :: [ApplicationCommandPermissions] -> ShowS
show :: ApplicationCommandPermissions -> String
$cshow :: ApplicationCommandPermissions -> String
showsPrec :: Int -> ApplicationCommandPermissions -> ShowS
$cshowsPrec :: Int -> ApplicationCommandPermissions -> ShowS
Show, ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
(ApplicationCommandPermissions
 -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> Eq ApplicationCommandPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c/= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
== :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c== :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
Eq, Eq ApplicationCommandPermissions
Eq ApplicationCommandPermissions
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Ordering)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> ApplicationCommandPermissions)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> ApplicationCommandPermissions)
-> Ord ApplicationCommandPermissions
ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
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 :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
$cmin :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
max :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
$cmax :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
>= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c>= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
> :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c> :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
<= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c<= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
< :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c< :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
compare :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
$ccompare :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
$cp1Ord :: Eq ApplicationCommandPermissions
Ord, ReadPrec [ApplicationCommandPermissions]
ReadPrec ApplicationCommandPermissions
Int -> ReadS ApplicationCommandPermissions
ReadS [ApplicationCommandPermissions]
(Int -> ReadS ApplicationCommandPermissions)
-> ReadS [ApplicationCommandPermissions]
-> ReadPrec ApplicationCommandPermissions
-> ReadPrec [ApplicationCommandPermissions]
-> Read ApplicationCommandPermissions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandPermissions]
$creadListPrec :: ReadPrec [ApplicationCommandPermissions]
readPrec :: ReadPrec ApplicationCommandPermissions
$creadPrec :: ReadPrec ApplicationCommandPermissions
readList :: ReadS [ApplicationCommandPermissions]
$creadList :: ReadS [ApplicationCommandPermissions]
readsPrec :: Int -> ReadS ApplicationCommandPermissions
$creadsPrec :: Int -> ReadS ApplicationCommandPermissions
Read)

instance FromJSON ApplicationCommandPermissions where
  parseJSON :: Value -> Parser ApplicationCommandPermissions
parseJSON =
    String
-> (Object -> Parser ApplicationCommandPermissions)
-> Value
-> Parser ApplicationCommandPermissions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommandPermissions"
      ( \Object
v ->
          ApplicationCommandId
-> Integer -> Bool -> ApplicationCommandPermissions
ApplicationCommandPermissions
            (ApplicationCommandId
 -> Integer -> Bool -> ApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser (Integer -> Bool -> ApplicationCommandPermissions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser (Integer -> Bool -> ApplicationCommandPermissions)
-> Parser Integer -> Parser (Bool -> ApplicationCommandPermissions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
            Parser (Bool -> ApplicationCommandPermissions)
-> Parser Bool -> Parser ApplicationCommandPermissions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permission"
      )

instance ToJSON ApplicationCommandPermissions where
  toJSON :: ApplicationCommandPermissions -> Value
toJSON ApplicationCommandPermissions {Bool
Integer
ApplicationCommandId
applicationCommandPermissionsPermission :: Bool
applicationCommandPermissionsType :: Integer
applicationCommandPermissionsId :: ApplicationCommandId
applicationCommandPermissionsPermission :: ApplicationCommandPermissions -> Bool
applicationCommandPermissionsType :: ApplicationCommandPermissions -> Integer
applicationCommandPermissionsId :: ApplicationCommandPermissions -> ApplicationCommandId
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
applicationCommandPermissionsId),
              (Key
"type", Integer -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Integer
applicationCommandPermissionsType),
              (Key
"permission", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
applicationCommandPermissionsPermission)
            ]
      ]