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

module Discord.Internal.Types.ApplicationCommands
  ( ApplicationCommand (..),
    Options (..),
    OptionSubcommandOrGroup (..),
    OptionSubcommand (..),
    OptionValue (..),
    createChatInput,
    createUser,
    createMessage,
    CreateApplicationCommand (..),
    EditApplicationCommand (..),
    defaultEditApplicationCommand,
    Choice (..),
    ChannelTypeOption (..),
    GuildApplicationCommandPermissions (..),
    ApplicationCommandPermissions (..),
    Number,
    AutocompleteOrChoice,
    LocalizedText,
    Locale
  )
where

import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Number, Object), object, withArray, withObject, (.!=), (.:), (.:!), (.:?))
import Data.Aeson.Types (Pair, Parser)
import Data.Foldable (Foldable (toList))
import Data.Scientific (Scientific)
import Data.Char (isLower, isNumber)
import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, Snowflake, objectFromMaybes, (.==), (.=?))
import Data.Map.Strict (Map)
import Discord.Internal.Types.Channel ( ChannelTypeOption(..) )

import qualified Data.Text as T

type Number = Scientific

-- | 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 -> ApplicationId
applicationCommandApplicationId :: ApplicationId,
        -- | The guild the application command is registered in.
        ApplicationCommand -> Maybe GuildId
applicationCommandGuildId :: Maybe GuildId,
        -- | The name of the application command.
        ApplicationCommand -> Text
applicationCommandName :: T.Text,
        -- | The localized names of the application command.
        ApplicationCommand -> Maybe LocalizedText
applicationCommandLocalizedName :: Maybe LocalizedText,
        -- | What permissions are required to use this command by default.
        ApplicationCommand -> Maybe Text
applicationCommandDefaultMemberPermissions :: Maybe T.Text,
        -- | Whether the command is available in DMs.
        ApplicationCommand -> Maybe Bool
applicationCommandDMPermission :: Maybe Bool,
        -- | Autoincrementing version identifier updated during substantial record changes.
        ApplicationCommand -> Snowflake
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,
        -- | The localized names of the application command.
        applicationCommandLocalizedName :: Maybe LocalizedText,
        -- | What permissions are required to use this command by default.
        applicationCommandDefaultMemberPermissions :: Maybe T.Text,
        -- | Whether the command is available in DMs.
        applicationCommandDMPermission :: Maybe 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 localized names of the application command.
        applicationCommandLocalizedName :: Maybe LocalizedText,
        -- | The description of the application command.
        ApplicationCommand -> Text
applicationCommandDescription :: T.Text,
        -- | The localized descriptions of the application command.
        ApplicationCommand -> Maybe LocalizedText
applicationCommandLocalizedDescription :: Maybe LocalizedText,
        -- | The parameters for the command.
        ApplicationCommand -> Maybe Options
applicationCommandOptions :: Maybe Options,
        -- | What permissions are required to use this command by default.
        applicationCommandDefaultMemberPermissions :: Maybe T.Text,
        -- | Whether the command is available in DMs.
        applicationCommandDMPermission :: Maybe 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
$cshowsPrec :: Int -> ApplicationCommand -> ShowS
showsPrec :: Int -> ApplicationCommand -> ShowS
$cshow :: ApplicationCommand -> String
show :: ApplicationCommand -> String
$cshowList :: [ApplicationCommand] -> ShowS
showList :: [ApplicationCommand] -> ShowS
Show, ApplicationCommand -> ApplicationCommand -> Bool
(ApplicationCommand -> ApplicationCommand -> Bool)
-> (ApplicationCommand -> ApplicationCommand -> Bool)
-> Eq ApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationCommand -> ApplicationCommand -> Bool
== :: ApplicationCommand -> ApplicationCommand -> Bool
$c/= :: ApplicationCommand -> ApplicationCommand -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS ApplicationCommand
readsPrec :: Int -> ReadS ApplicationCommand
$creadList :: ReadS [ApplicationCommand]
readList :: ReadS [ApplicationCommand]
$creadPrec :: ReadPrec ApplicationCommand
readPrec :: ReadPrec ApplicationCommand
$creadListPrec :: ReadPrec [ApplicationCommand]
readListPrec :: ReadPrec [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"
          ApplicationId
aid <- Object
v Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
          Maybe GuildId
gid <- Object
v Object -> Key -> Parser (Maybe GuildId)
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"
          Maybe LocalizedText
lname <- Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_localizations"
          Maybe Text
defPerm <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_member_permissions"
          Maybe Bool
dmPerm <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dm_permission"
          Snowflake
version <- Object
v Object -> Key -> Parser Snowflake
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommand -> Parser ApplicationCommand)
-> ApplicationCommand -> Parser ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationId
-> Maybe GuildId
-> Text
-> Maybe LocalizedText
-> Maybe Text
-> Maybe Bool
-> Snowflake
-> ApplicationCommand
ApplicationCommandUser ApplicationCommandId
acid ApplicationId
aid Maybe GuildId
gid Text
name Maybe LocalizedText
lname Maybe Text
defPerm Maybe Bool
dmPerm Snowflake
version
            (Just Int
3) -> ApplicationCommand -> Parser ApplicationCommand
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommand -> Parser ApplicationCommand)
-> ApplicationCommand -> Parser ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationId
-> Maybe GuildId
-> Text
-> Maybe LocalizedText
-> Maybe Text
-> Maybe Bool
-> Snowflake
-> ApplicationCommand
ApplicationCommandMessage ApplicationCommandId
acid ApplicationId
aid Maybe GuildId
gid Text
name Maybe LocalizedText
lname Maybe Text
defPerm Maybe Bool
dmPerm Snowflake
version
            Maybe Int
_ -> do
              Text
desc <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
              Maybe Options
options <- Object
v Object -> Key -> Parser (Maybe Options)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
              Maybe LocalizedText
ldesc <- Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description_localizations"
              ApplicationCommand -> Parser ApplicationCommand
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommand -> Parser ApplicationCommand)
-> ApplicationCommand -> Parser ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationId
-> Maybe GuildId
-> Text
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Maybe Options
-> Maybe Text
-> Maybe Bool
-> Snowflake
-> ApplicationCommand
ApplicationCommandChatInput ApplicationCommandId
acid ApplicationId
aid Maybe GuildId
gid Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Maybe Options
options Maybe Text
defPerm Maybe Bool
dmPerm Snowflake
version
      )

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

instance FromJSON Options where
  parseJSON :: Value -> Parser Options
parseJSON =
    String -> (Array -> Parser Options) -> Value -> Parser Options
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray
      String
"Options"
      ( \Array
a -> do
          let a' :: [Value]
a' = Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
          case [Value]
a' of
            [] -> Options -> Parser Options
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Parser Options) -> Options -> Parser Options
forall a b. (a -> b) -> a -> b
$ [OptionValue] -> Options
OptionsValues []
            (Value
v' : [Value]
_) ->
              String -> (Object -> Parser Options) -> Value -> Parser Options
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
                String
"Options 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 [OptionSubcommandOrGroup] -> Options
OptionsSubcommands ([OptionSubcommandOrGroup] -> Options)
-> Parser [OptionSubcommandOrGroup] -> Parser Options
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser OptionSubcommandOrGroup)
-> [Value] -> Parser [OptionSubcommandOrGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser OptionSubcommandOrGroup
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                      else [OptionValue] -> Options
OptionsValues ([OptionValue] -> Options)
-> Parser [OptionValue] -> Parser Options
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser OptionValue) -> [Value] -> Parser [OptionValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser OptionValue
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                )
                Value
v'
      )

instance ToJSON Options where
  toJSON :: Options -> Value
toJSON (OptionsSubcommands [OptionSubcommandOrGroup]
o) = [OptionSubcommandOrGroup] -> Value
forall a. ToJSON a => a -> Value
toJSON [OptionSubcommandOrGroup]
o
  toJSON (OptionsValues [OptionValue]
o) = [OptionValue] -> Value
forall a. ToJSON a => a -> Value
toJSON [OptionValue]
o

-- | Either a subcommand group or a subcommand.
data OptionSubcommandOrGroup
  = OptionSubcommandGroup
      { -- | The name of the subcommand group
        OptionSubcommandOrGroup -> Text
optionSubcommandGroupName :: T.Text,
        -- | The localized name of the subcommand group
        OptionSubcommandOrGroup -> Maybe LocalizedText
optionSubcommandGroupLocalizedName :: Maybe LocalizedText,
        -- | The description of the subcommand group
        OptionSubcommandOrGroup -> Text
optionSubcommandGroupDescription :: T.Text,
        -- | The localized description of the subcommand group
        OptionSubcommandOrGroup -> Maybe LocalizedText
optionSubcommandGroupLocalizedDescription :: Maybe LocalizedText,
        -- | The subcommands in this subcommand group
        OptionSubcommandOrGroup -> [OptionSubcommand]
optionSubcommandGroupOptions :: [OptionSubcommand]
      }
  | OptionSubcommandOrGroupSubcommand OptionSubcommand
  deriving (Int -> OptionSubcommandOrGroup -> ShowS
[OptionSubcommandOrGroup] -> ShowS
OptionSubcommandOrGroup -> String
(Int -> OptionSubcommandOrGroup -> ShowS)
-> (OptionSubcommandOrGroup -> String)
-> ([OptionSubcommandOrGroup] -> ShowS)
-> Show OptionSubcommandOrGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionSubcommandOrGroup -> ShowS
showsPrec :: Int -> OptionSubcommandOrGroup -> ShowS
$cshow :: OptionSubcommandOrGroup -> String
show :: OptionSubcommandOrGroup -> String
$cshowList :: [OptionSubcommandOrGroup] -> ShowS
showList :: [OptionSubcommandOrGroup] -> ShowS
Show, OptionSubcommandOrGroup -> OptionSubcommandOrGroup -> Bool
(OptionSubcommandOrGroup -> OptionSubcommandOrGroup -> Bool)
-> (OptionSubcommandOrGroup -> OptionSubcommandOrGroup -> Bool)
-> Eq OptionSubcommandOrGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionSubcommandOrGroup -> OptionSubcommandOrGroup -> Bool
== :: OptionSubcommandOrGroup -> OptionSubcommandOrGroup -> Bool
$c/= :: OptionSubcommandOrGroup -> OptionSubcommandOrGroup -> Bool
/= :: OptionSubcommandOrGroup -> OptionSubcommandOrGroup -> Bool
Eq, ReadPrec [OptionSubcommandOrGroup]
ReadPrec OptionSubcommandOrGroup
Int -> ReadS OptionSubcommandOrGroup
ReadS [OptionSubcommandOrGroup]
(Int -> ReadS OptionSubcommandOrGroup)
-> ReadS [OptionSubcommandOrGroup]
-> ReadPrec OptionSubcommandOrGroup
-> ReadPrec [OptionSubcommandOrGroup]
-> Read OptionSubcommandOrGroup
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OptionSubcommandOrGroup
readsPrec :: Int -> ReadS OptionSubcommandOrGroup
$creadList :: ReadS [OptionSubcommandOrGroup]
readList :: ReadS [OptionSubcommandOrGroup]
$creadPrec :: ReadPrec OptionSubcommandOrGroup
readPrec :: ReadPrec OptionSubcommandOrGroup
$creadListPrec :: ReadPrec [OptionSubcommandOrGroup]
readListPrec :: ReadPrec [OptionSubcommandOrGroup]
Read)

instance FromJSON OptionSubcommandOrGroup where
  parseJSON :: Value -> Parser OptionSubcommandOrGroup
parseJSON =
    String
-> (Object -> Parser OptionSubcommandOrGroup)
-> Value
-> Parser OptionSubcommandOrGroup
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionSubcommandOrGroup"
      ( \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
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> [OptionSubcommand]
-> OptionSubcommandOrGroup
OptionSubcommandGroup
                (Text
 -> Maybe LocalizedText
 -> Text
 -> Maybe LocalizedText
 -> [OptionSubcommand]
 -> OptionSubcommandOrGroup)
-> Parser Text
-> Parser
     (Maybe LocalizedText
      -> Text
      -> Maybe LocalizedText
      -> [OptionSubcommand]
      -> OptionSubcommandOrGroup)
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
  (Maybe LocalizedText
   -> Text
   -> Maybe LocalizedText
   -> [OptionSubcommand]
   -> OptionSubcommandOrGroup)
-> Parser (Maybe LocalizedText)
-> Parser
     (Text
      -> Maybe LocalizedText
      -> [OptionSubcommand]
      -> OptionSubcommandOrGroup)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_localizations"
                Parser
  (Text
   -> Maybe LocalizedText
   -> [OptionSubcommand]
   -> OptionSubcommandOrGroup)
-> Parser Text
-> Parser
     (Maybe LocalizedText
      -> [OptionSubcommand] -> OptionSubcommandOrGroup)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
  (Maybe LocalizedText
   -> [OptionSubcommand] -> OptionSubcommandOrGroup)
-> Parser (Maybe LocalizedText)
-> Parser ([OptionSubcommand] -> OptionSubcommandOrGroup)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description_localizations"
                Parser ([OptionSubcommand] -> OptionSubcommandOrGroup)
-> Parser [OptionSubcommand] -> Parser OptionSubcommandOrGroup
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [OptionSubcommand]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"options"
            Int
1 -> OptionSubcommand -> OptionSubcommandOrGroup
OptionSubcommandOrGroupSubcommand (OptionSubcommand -> OptionSubcommandOrGroup)
-> Parser OptionSubcommand -> Parser OptionSubcommandOrGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OptionSubcommand
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Int
_ -> String -> Parser OptionSubcommandOrGroup
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected subcommand group type"
      )

instance ToJSON OptionSubcommandOrGroup where
  toJSON :: OptionSubcommandOrGroup -> Value
toJSON OptionSubcommandGroup {[OptionSubcommand]
Maybe LocalizedText
Text
optionSubcommandGroupName :: OptionSubcommandOrGroup -> Text
optionSubcommandGroupLocalizedName :: OptionSubcommandOrGroup -> Maybe LocalizedText
optionSubcommandGroupDescription :: OptionSubcommandOrGroup -> Text
optionSubcommandGroupLocalizedDescription :: OptionSubcommandOrGroup -> Maybe LocalizedText
optionSubcommandGroupOptions :: OptionSubcommandOrGroup -> [OptionSubcommand]
optionSubcommandGroupName :: Text
optionSubcommandGroupLocalizedName :: Maybe LocalizedText
optionSubcommandGroupDescription :: Text
optionSubcommandGroupLocalizedDescription :: Maybe LocalizedText
optionSubcommandGroupOptions :: [OptionSubcommand]
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
2),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionSubcommandGroupName),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionSubcommandGroupLocalizedName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionSubcommandGroupDescription),
        (Key
"description_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionSubcommandGroupLocalizedDescription),
        (Key
"options", [OptionSubcommand] -> Value
forall a. ToJSON a => a -> Value
toJSON [OptionSubcommand]
optionSubcommandGroupOptions)
      ]
  toJSON (OptionSubcommandOrGroupSubcommand OptionSubcommand
a) = OptionSubcommand -> Value
forall a. ToJSON a => a -> Value
toJSON OptionSubcommand
a

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

instance FromJSON OptionSubcommand where
  parseJSON :: Value -> Parser OptionSubcommand
parseJSON =
    String
-> (Object -> Parser OptionSubcommand)
-> Value
-> Parser OptionSubcommand
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionSubcommand"
      ( \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
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> [OptionValue]
-> OptionSubcommand
OptionSubcommand
                (Text
 -> Maybe LocalizedText
 -> Text
 -> Maybe LocalizedText
 -> [OptionValue]
 -> OptionSubcommand)
-> Parser Text
-> Parser
     (Maybe LocalizedText
      -> Text
      -> Maybe LocalizedText
      -> [OptionValue]
      -> OptionSubcommand)
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
  (Maybe LocalizedText
   -> Text
   -> Maybe LocalizedText
   -> [OptionValue]
   -> OptionSubcommand)
-> Parser (Maybe LocalizedText)
-> Parser
     (Text -> Maybe LocalizedText -> [OptionValue] -> OptionSubcommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_localizations"
                Parser
  (Text -> Maybe LocalizedText -> [OptionValue] -> OptionSubcommand)
-> Parser Text
-> Parser
     (Maybe LocalizedText -> [OptionValue] -> OptionSubcommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 (Maybe LocalizedText -> [OptionValue] -> OptionSubcommand)
-> Parser (Maybe LocalizedText)
-> Parser ([OptionValue] -> OptionSubcommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description_localizations"
                Parser ([OptionValue] -> OptionSubcommand)
-> Parser [OptionValue] -> Parser OptionSubcommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [OptionValue])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options" Parser (Maybe [OptionValue])
-> [OptionValue] -> Parser [OptionValue]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
            Int
_ -> String -> Parser OptionSubcommand
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected subcommand type"
      )

instance ToJSON OptionSubcommand where
  toJSON :: OptionSubcommand -> Value
toJSON OptionSubcommand {[OptionValue]
Maybe LocalizedText
Text
optionSubcommandName :: OptionSubcommand -> Text
optionSubcommandLocalizedName :: OptionSubcommand -> Maybe LocalizedText
optionSubcommandDescription :: OptionSubcommand -> Text
optionSubcommandLocalizedDescription :: OptionSubcommand -> Maybe LocalizedText
optionSubcommandOptions :: OptionSubcommand -> [OptionValue]
optionSubcommandName :: Text
optionSubcommandLocalizedName :: Maybe LocalizedText
optionSubcommandDescription :: Text
optionSubcommandLocalizedDescription :: Maybe LocalizedText
optionSubcommandOptions :: [OptionValue]
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
1),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionSubcommandName),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionSubcommandLocalizedName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionSubcommandDescription),
        (Key
"description_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionSubcommandLocalizedDescription),
        (Key
"options", [OptionValue] -> Value
forall a. ToJSON a => a -> Value
toJSON [OptionValue]
optionSubcommandOptions)
      ]

-- | Data for a single value.
data OptionValue
  = OptionValueString
      { -- | The name of the value
        OptionValue -> Text
optionValueName :: T.Text,
        -- | The localized name of the value
        OptionValue -> Maybe LocalizedText
optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        OptionValue -> Text
optionValueDescription :: T.Text,
        -- | The localized description of the value
        OptionValue -> Maybe LocalizedText
optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        OptionValue -> Bool
optionValueRequired :: Bool,
        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`
        OptionValue -> AutocompleteOrChoice Text
optionValueStringChoices :: AutocompleteOrChoice T.Text,
        -- | The minimum length of the string (minimum 0)
        OptionValue -> Maybe Integer
optionValueStringMinLen :: Maybe Integer,
        -- | The maximum length of the string (minimum 1)
        OptionValue -> Maybe Integer
optionValueStringMaxLen :: Maybe Integer
      }
  | OptionValueInteger
      { -- | The name of the value
        optionValueName :: T.Text,
        -- | The localized name of the value
        optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        optionValueDescription :: T.Text,
        -- | The localized description of the value
        optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        optionValueRequired :: Bool,
        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`
        OptionValue -> AutocompleteOrChoice Integer
optionValueIntegerChoices :: AutocompleteOrChoice Integer,
        -- | The lower bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        OptionValue -> Maybe Integer
optionValueIntegerMinVal :: Maybe Integer,
        -- | The upper bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        OptionValue -> Maybe Integer
optionValueIntegerMaxVal :: Maybe Integer
      }
  | OptionValueBoolean
      { -- | The name of the value
        optionValueName :: T.Text,
        -- | The localized name of the value
        optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        optionValueDescription :: T.Text,
        -- | The localized description of the value
        optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        optionValueRequired :: Bool
      }
  | OptionValueUser
      { -- | The name of the value
        optionValueName :: T.Text,
        -- | The localized name of the value
        optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        optionValueDescription :: T.Text,
        -- | The localized description of the value
        optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        optionValueRequired :: Bool
      }
  | OptionValueChannel
      { -- | The name of the value
        optionValueName :: T.Text,
        -- | The localized name of the value
        optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        optionValueDescription :: T.Text,
        -- | The localized description of the value
        optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        optionValueRequired :: Bool,
        -- | What type of channel can be put in here
        OptionValue -> Maybe [ChannelTypeOption]
optionValueChannelTypes :: Maybe [ChannelTypeOption]
      }
  | OptionValueRole
      { -- | The name of the value
        optionValueName :: T.Text,
        -- | The localized name of the value
        optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        optionValueDescription :: T.Text,
        -- | The localized description of the value
        optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        optionValueRequired :: Bool
      }
  | OptionValueMentionable
      { -- | The name of the value
        optionValueName :: T.Text,
        -- | The localized name of the value
        optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        optionValueDescription :: T.Text,
        -- | The localized description of the value
        optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        optionValueRequired :: Bool
      }
  | OptionValueNumber
      { -- | The name of the value
        optionValueName :: T.Text,
        -- | The localized name of the value
        optionValueLocalizedName :: Maybe LocalizedText,
        -- | The description of the value
        optionValueDescription :: T.Text,
        -- | The localized description of the value
        optionValueLocalizedDescription :: Maybe LocalizedText,
        -- | Whether this option is required
        optionValueRequired :: Bool,
        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`
        OptionValue -> AutocompleteOrChoice Scientific
optionValueNumberChoices :: AutocompleteOrChoice Number,
        -- | The lower bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        OptionValue -> Maybe Scientific
optionValueNumberMinVal :: Maybe Number,
        -- | The upper bound of values permitted. If choices are provided or autocomplete is on, this can be ignored
        OptionValue -> Maybe Scientific
optionValueNumberMaxVal :: Maybe Number
      }
  deriving (Int -> OptionValue -> ShowS
[OptionValue] -> ShowS
OptionValue -> String
(Int -> OptionValue -> ShowS)
-> (OptionValue -> String)
-> ([OptionValue] -> ShowS)
-> Show OptionValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionValue -> ShowS
showsPrec :: Int -> OptionValue -> ShowS
$cshow :: OptionValue -> String
show :: OptionValue -> String
$cshowList :: [OptionValue] -> ShowS
showList :: [OptionValue] -> ShowS
Show, OptionValue -> OptionValue -> Bool
(OptionValue -> OptionValue -> Bool)
-> (OptionValue -> OptionValue -> Bool) -> Eq OptionValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionValue -> OptionValue -> Bool
== :: OptionValue -> OptionValue -> Bool
$c/= :: OptionValue -> OptionValue -> Bool
/= :: OptionValue -> OptionValue -> Bool
Eq, ReadPrec [OptionValue]
ReadPrec OptionValue
Int -> ReadS OptionValue
ReadS [OptionValue]
(Int -> ReadS OptionValue)
-> ReadS [OptionValue]
-> ReadPrec OptionValue
-> ReadPrec [OptionValue]
-> Read OptionValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OptionValue
readsPrec :: Int -> ReadS OptionValue
$creadList :: ReadS [OptionValue]
readList :: ReadS [OptionValue]
$creadPrec :: ReadPrec OptionValue
readPrec :: ReadPrec OptionValue
$creadListPrec :: ReadPrec [OptionValue]
readListPrec :: ReadPrec [OptionValue]
Read)

instance FromJSON OptionValue where
  parseJSON :: Value -> Parser OptionValue
parseJSON =
    String
-> (Object -> Parser OptionValue) -> Value -> Parser OptionValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionValue"
      ( \Object
v -> do
          Text
name <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Maybe LocalizedText
lname <- Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_localizations"
          Text
desc <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
          Maybe LocalizedText
ldesc <- Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description_localizations"
          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
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> AutocompleteOrChoice Text
-> Maybe Integer
-> Maybe Integer
-> OptionValue
OptionValueString Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
                (AutocompleteOrChoice Text
 -> Maybe Integer -> Maybe Integer -> OptionValue)
-> Parser (AutocompleteOrChoice Text)
-> Parser (Maybe Integer -> Maybe Integer -> OptionValue)
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)
                Parser (Maybe Integer -> Maybe Integer -> OptionValue)
-> Parser (Maybe Integer) -> Parser (Maybe Integer -> OptionValue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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_length"
                Parser (Maybe Integer -> OptionValue)
-> Parser (Maybe Integer) -> Parser OptionValue
forall a b. Parser (a -> b) -> Parser a -> Parser b
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_length"
            Int
4 ->
              Text
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> AutocompleteOrChoice Integer
-> Maybe Integer
-> Maybe Integer
-> OptionValue
OptionValueInteger Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
                (AutocompleteOrChoice Integer
 -> Maybe Integer -> Maybe Integer -> OptionValue)
-> Parser (AutocompleteOrChoice Integer)
-> Parser (Maybe Integer -> Maybe Integer -> OptionValue)
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 -> OptionValue)
-> Parser (Maybe Integer) -> Parser (Maybe Integer -> OptionValue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 -> OptionValue)
-> Parser (Maybe Integer) -> Parser OptionValue
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> AutocompleteOrChoice Scientific
-> Maybe Scientific
-> Maybe Scientific
-> OptionValue
OptionValueNumber Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
                (AutocompleteOrChoice Scientific
 -> Maybe Scientific -> Maybe Scientific -> OptionValue)
-> Parser (AutocompleteOrChoice Scientific)
-> Parser (Maybe Scientific -> Maybe Scientific -> OptionValue)
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 -> OptionValue)
-> Parser (Maybe Scientific)
-> Parser (Maybe Scientific -> OptionValue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 -> OptionValue)
-> Parser (Maybe Scientific) -> Parser OptionValue
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> Maybe [ChannelTypeOption]
-> OptionValue
OptionValueChannel Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
                (Maybe [ChannelTypeOption] -> OptionValue)
-> Parser (Maybe [ChannelTypeOption]) -> Parser OptionValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe [ChannelTypeOption])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_types"
            Int
5 -> OptionValue -> Parser OptionValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionValue -> Parser OptionValue)
-> OptionValue -> Parser OptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> OptionValue
OptionValueBoolean Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
            Int
6 -> OptionValue -> Parser OptionValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionValue -> Parser OptionValue)
-> OptionValue -> Parser OptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> OptionValue
OptionValueUser Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
            Int
8 -> OptionValue -> Parser OptionValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionValue -> Parser OptionValue)
-> OptionValue -> Parser OptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> OptionValue
OptionValueRole Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
            Int
9 -> OptionValue -> Parser OptionValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionValue -> Parser OptionValue)
-> OptionValue -> Parser OptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Bool
-> OptionValue
OptionValueMentionable Text
name Maybe LocalizedText
lname Text
desc Maybe LocalizedText
ldesc Bool
required
            Int
_ -> String -> Parser OptionValue
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown application command option value type"
      )

instance ToJSON OptionValue where
  toJSON :: OptionValue -> Value
toJSON OptionValueString {Bool
Maybe Integer
Maybe LocalizedText
AutocompleteOrChoice Text
Text
optionValueName :: OptionValue -> Text
optionValueLocalizedName :: OptionValue -> Maybe LocalizedText
optionValueDescription :: OptionValue -> Text
optionValueLocalizedDescription :: OptionValue -> Maybe LocalizedText
optionValueRequired :: OptionValue -> Bool
optionValueStringChoices :: OptionValue -> AutocompleteOrChoice Text
optionValueStringMinLen :: OptionValue -> Maybe Integer
optionValueStringMaxLen :: OptionValue -> Maybe Integer
optionValueName :: Text
optionValueLocalizedName :: Maybe LocalizedText
optionValueDescription :: Text
optionValueLocalizedDescription :: Maybe LocalizedText
optionValueRequired :: Bool
optionValueStringChoices :: AutocompleteOrChoice Text
optionValueStringMinLen :: Maybe Integer
optionValueStringMaxLen :: Maybe Integer
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
3),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueDescription),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedName),
        (Key
"description_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
optionValueRequired),
        (Key
"min_length", Maybe Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Integer
optionValueStringMinLen),
        (Key
"max_length", Maybe Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Integer
optionValueStringMaxLen),
        AutocompleteOrChoice Text -> Pair
forall a. ToJSON a => AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON AutocompleteOrChoice Text
optionValueStringChoices
      ]
  toJSON OptionValueInteger {Bool
Maybe Integer
Maybe LocalizedText
AutocompleteOrChoice Integer
Text
optionValueName :: OptionValue -> Text
optionValueLocalizedName :: OptionValue -> Maybe LocalizedText
optionValueDescription :: OptionValue -> Text
optionValueLocalizedDescription :: OptionValue -> Maybe LocalizedText
optionValueRequired :: OptionValue -> Bool
optionValueIntegerChoices :: OptionValue -> AutocompleteOrChoice Integer
optionValueIntegerMinVal :: OptionValue -> Maybe Integer
optionValueIntegerMaxVal :: OptionValue -> Maybe Integer
optionValueName :: Text
optionValueLocalizedName :: Maybe LocalizedText
optionValueDescription :: Text
optionValueLocalizedDescription :: Maybe LocalizedText
optionValueRequired :: Bool
optionValueIntegerChoices :: AutocompleteOrChoice Integer
optionValueIntegerMinVal :: Maybe Integer
optionValueIntegerMaxVal :: Maybe Integer
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
4),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueDescription),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedName),
        (Key
"description_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
optionValueRequired),
        (Key
"min_value", Maybe Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Integer
optionValueIntegerMinVal),
        (Key
"max_value", Maybe Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Integer
optionValueIntegerMaxVal),
        AutocompleteOrChoice Integer -> Pair
forall a. ToJSON a => AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON AutocompleteOrChoice Integer
optionValueIntegerChoices
      ]
  toJSON OptionValueNumber {Bool
Maybe LocalizedText
Maybe Scientific
AutocompleteOrChoice Scientific
Text
optionValueName :: OptionValue -> Text
optionValueLocalizedName :: OptionValue -> Maybe LocalizedText
optionValueDescription :: OptionValue -> Text
optionValueLocalizedDescription :: OptionValue -> Maybe LocalizedText
optionValueRequired :: OptionValue -> Bool
optionValueNumberChoices :: OptionValue -> AutocompleteOrChoice Scientific
optionValueNumberMinVal :: OptionValue -> Maybe Scientific
optionValueNumberMaxVal :: OptionValue -> Maybe Scientific
optionValueName :: Text
optionValueLocalizedName :: Maybe LocalizedText
optionValueDescription :: Text
optionValueLocalizedDescription :: Maybe LocalizedText
optionValueRequired :: Bool
optionValueNumberChoices :: AutocompleteOrChoice Scientific
optionValueNumberMinVal :: Maybe Scientific
optionValueNumberMaxVal :: Maybe Scientific
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
10),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueDescription),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedName),
        (Key
"description_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
optionValueRequired),
        (Key
"min_value", Maybe Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Scientific
optionValueNumberMinVal),
        (Key
"max_value", Maybe Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Scientific
optionValueNumberMaxVal),
        AutocompleteOrChoice Scientific -> Pair
forall a. ToJSON a => AutocompleteOrChoice a -> Pair
choiceOrAutocompleteToJSON AutocompleteOrChoice Scientific
optionValueNumberChoices
      ]
  toJSON OptionValueChannel {Bool
Maybe [ChannelTypeOption]
Maybe LocalizedText
Text
optionValueName :: OptionValue -> Text
optionValueLocalizedName :: OptionValue -> Maybe LocalizedText
optionValueDescription :: OptionValue -> Text
optionValueLocalizedDescription :: OptionValue -> Maybe LocalizedText
optionValueRequired :: OptionValue -> Bool
optionValueChannelTypes :: OptionValue -> Maybe [ChannelTypeOption]
optionValueName :: Text
optionValueLocalizedName :: Maybe LocalizedText
optionValueDescription :: Text
optionValueLocalizedDescription :: Maybe LocalizedText
optionValueRequired :: Bool
optionValueChannelTypes :: Maybe [ChannelTypeOption]
..} =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number Scientific
7),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueName),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
optionValueDescription),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedName),
        (Key
"description_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
optionValueLocalizedDescription),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
optionValueRequired),
        (Key
"channel_types", Maybe [ChannelTypeOption] -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe [ChannelTypeOption]
optionValueChannelTypes)
      ]
  toJSON OptionValue
acov =
    [Pair] -> Value
object
      [ (Key
"type", Scientific -> Value
Number (OptionValue -> Scientific
forall {a}. Num a => OptionValue -> a
t OptionValue
acov)),
        (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ OptionValue -> Text
optionValueName OptionValue
acov),
        (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ OptionValue -> Text
optionValueDescription OptionValue
acov),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe LocalizedText -> Value) -> Maybe LocalizedText -> Value
forall a b. (a -> b) -> a -> b
$ OptionValue -> Maybe LocalizedText
optionValueLocalizedName OptionValue
acov),
        (Key
"description_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe LocalizedText -> Value) -> Maybe LocalizedText -> Value
forall a b. (a -> b) -> a -> b
$ OptionValue -> Maybe LocalizedText
optionValueLocalizedDescription OptionValue
acov),
        (Key
"required", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ OptionValue -> Bool
optionValueRequired OptionValue
acov)
      ]
    where
      t :: OptionValue -> a
t OptionValueBoolean {} = a
5
      t OptionValueUser {} = a
6
      t OptionValueRole {} = a
8
      t OptionValueMentionable {} = a
9
      t OptionValue
_ = -a
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
createName :: T.Text,
        -- | The localized application name
        CreateApplicationCommand -> Maybe LocalizedText
createLocalizedName :: Maybe LocalizedText,
        -- | The application command description (1-100 chars).
        CreateApplicationCommand -> Text
createDescription :: T.Text,
        -- | The localized application command description.
        CreateApplicationCommand -> Maybe LocalizedText
createLocalizedDescription :: Maybe LocalizedText,
        -- | What options the application (max length 25).
        CreateApplicationCommand -> Maybe Options
createOptions :: Maybe Options,
        -- | The default permissions required for members set when using the command
        -- in a guild.
        -- Set of permissions represented as a bit set.
        CreateApplicationCommand -> Maybe Text
createDefaultMemberPermissions :: Maybe T.Text,
        -- | Whether the command is available in DMs.
        CreateApplicationCommand -> Maybe Bool
createDMPermission :: Maybe Bool
      }
  | CreateApplicationCommandUser
      { -- | The application command name (1-32 chars).
        createName :: T.Text,
        -- | The localized application name
        createLocalizedName :: Maybe LocalizedText,
        -- | The default permissions required for members set when using the command
        -- in a guild.
        -- Set of permissions represented as a bit set.
        createDefaultMemberPermissions :: Maybe T.Text,
        -- | Whether the command is available in DMs.
        createDMPermission :: Maybe Bool
      }
  | CreateApplicationCommandMessage
      { -- | The application command name (1-32 chars).
        createName :: T.Text,
        -- | The localized application name
        createLocalizedName :: Maybe LocalizedText,
        -- | The default permissions required for members set when using the command
        -- in a guild.
        -- Set of permissions represented as a bit set.
        createDefaultMemberPermissions :: Maybe T.Text,
        -- | Whether the command is available in DMs.
        createDMPermission :: Maybe 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
$cshowsPrec :: Int -> CreateApplicationCommand -> ShowS
showsPrec :: Int -> CreateApplicationCommand -> ShowS
$cshow :: CreateApplicationCommand -> String
show :: CreateApplicationCommand -> String
$cshowList :: [CreateApplicationCommand] -> ShowS
showList :: [CreateApplicationCommand] -> ShowS
Show, CreateApplicationCommand -> CreateApplicationCommand -> Bool
(CreateApplicationCommand -> CreateApplicationCommand -> Bool)
-> (CreateApplicationCommand -> CreateApplicationCommand -> Bool)
-> Eq CreateApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
== :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
$c/= :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS CreateApplicationCommand
readsPrec :: Int -> ReadS CreateApplicationCommand
$creadList :: ReadS [CreateApplicationCommand]
readList :: ReadS [CreateApplicationCommand]
$creadPrec :: ReadPrec CreateApplicationCommand
readPrec :: ReadPrec CreateApplicationCommand
$creadListPrec :: ReadPrec [CreateApplicationCommand]
readListPrec :: ReadPrec [CreateApplicationCommand]
Read)

instance ToJSON CreateApplicationCommand where
  toJSON :: CreateApplicationCommand -> Value
toJSON CreateApplicationCommandChatInput {Maybe Bool
Maybe LocalizedText
Maybe Text
Maybe Options
Text
createName :: CreateApplicationCommand -> Text
createLocalizedName :: CreateApplicationCommand -> Maybe LocalizedText
createDescription :: CreateApplicationCommand -> Text
createLocalizedDescription :: CreateApplicationCommand -> Maybe LocalizedText
createOptions :: CreateApplicationCommand -> Maybe Options
createDefaultMemberPermissions :: CreateApplicationCommand -> Maybe Text
createDMPermission :: CreateApplicationCommand -> Maybe Bool
createName :: Text
createLocalizedName :: Maybe LocalizedText
createDescription :: Text
createLocalizedDescription :: Maybe LocalizedText
createOptions :: Maybe Options
createDefaultMemberPermissions :: Maybe Text
createDMPermission :: Maybe Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"name" Key -> Text -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Text
createName,
        Key
"name_localizations" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
createLocalizedName,
        Key
"description" Key -> Text -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Text
createDescription,
        Key
"description_localizations" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
createLocalizedDescription,
        Key
"options" Key -> Maybe Options -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Options
createOptions,
        Key
"default_member_permissions" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Maybe Text
createDefaultMemberPermissions,
        Key
"dm_permission" Key -> Maybe Bool -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Maybe Bool
createDMPermission,
        Key
"type" Key -> Value -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
1
      ]
  toJSON CreateApplicationCommandUser {Maybe Bool
Maybe LocalizedText
Maybe Text
Text
createName :: CreateApplicationCommand -> Text
createLocalizedName :: CreateApplicationCommand -> Maybe LocalizedText
createDefaultMemberPermissions :: CreateApplicationCommand -> Maybe Text
createDMPermission :: CreateApplicationCommand -> Maybe Bool
createName :: Text
createLocalizedName :: Maybe LocalizedText
createDefaultMemberPermissions :: Maybe Text
createDMPermission :: Maybe Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"name" Key -> Text -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Text
createName,
        Key
"name_localizations" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
createLocalizedName,
        Key
"default_member_permissions" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Maybe Text
createDefaultMemberPermissions,
        Key
"dm_permission" Key -> Maybe Bool -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Maybe Bool
createDMPermission,
        Key
"type" Key -> Value -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
2
      ]
  toJSON CreateApplicationCommandMessage {Maybe Bool
Maybe LocalizedText
Maybe Text
Text
createName :: CreateApplicationCommand -> Text
createLocalizedName :: CreateApplicationCommand -> Maybe LocalizedText
createDefaultMemberPermissions :: CreateApplicationCommand -> Maybe Text
createDMPermission :: CreateApplicationCommand -> Maybe Bool
createName :: Text
createLocalizedName :: Maybe LocalizedText
createDefaultMemberPermissions :: Maybe Text
createDMPermission :: Maybe Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"name" Key -> Text -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Text
createName,
        Key
"name_localizations" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
createLocalizedName,
        Key
"default_member_permissions" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Maybe Text
createDefaultMemberPermissions,
        Key
"dm_permission" Key -> Maybe Bool -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Maybe Bool
createDMPermission,
        Key
"type" Key -> Value -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== 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 -> Bool
validChar Text
name
  where
    l :: Int
l = Text -> Int
T.length Text
name
    validChar :: Char -> Bool
validChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isNumber Char
c

-- | 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.
createChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand
createChatInput :: Text -> Text -> Maybe CreateApplicationCommand
createChatInput 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
-> Maybe LocalizedText
-> Text
-> Maybe LocalizedText
-> Maybe Options
-> Maybe Text
-> Maybe Bool
-> CreateApplicationCommand
CreateApplicationCommandChatInput Text
name Maybe LocalizedText
forall a. Maybe a
Nothing Text
desc Maybe LocalizedText
forall a. Maybe a
Nothing Maybe Options
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
  | 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.
createUser :: T.Text -> Maybe CreateApplicationCommand
createUser :: Text -> Maybe CreateApplicationCommand
createUser 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
-> Maybe LocalizedText
-> Maybe Text
-> Maybe Bool
-> CreateApplicationCommand
CreateApplicationCommandUser Text
name Maybe LocalizedText
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
  | 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.
createMessage :: T.Text -> Maybe CreateApplicationCommand
createMessage :: Text -> Maybe CreateApplicationCommand
createMessage 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
-> Maybe LocalizedText
-> Maybe Text
-> Maybe Bool
-> CreateApplicationCommand
CreateApplicationCommandMessage Text
name Maybe LocalizedText
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
  | 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
editName :: Maybe T.Text,
        EditApplicationCommand -> Maybe LocalizedText
editLocalizedName :: Maybe LocalizedText,
        EditApplicationCommand -> Maybe Text
editDescription :: Maybe T.Text,
        EditApplicationCommand -> Maybe LocalizedText
editLocalizedDescription :: Maybe LocalizedText,
        EditApplicationCommand -> Maybe Options
editOptions :: Maybe Options,
        EditApplicationCommand -> Maybe Text
editDefaultMemberPermissions :: Maybe T.Text,
        EditApplicationCommand -> Maybe Bool
editDMPermission :: Maybe Bool
      }
  | EditApplicationCommandUser
      { editName :: Maybe T.Text,
        editLocalizedName :: Maybe LocalizedText,
        editDefaultMemberPermissions :: Maybe T.Text,
        editDMPermission :: Maybe Bool
      }
  | EditApplicationCommandMessage
      { editName :: Maybe T.Text,
        editLocalizedName :: Maybe LocalizedText,
        editDefaultMemberPermissions :: Maybe T.Text,
        editDMPermission :: Maybe Bool
      }

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

instance ToJSON EditApplicationCommand where
  toJSON :: EditApplicationCommand -> Value
toJSON EditApplicationCommandChatInput {Maybe Bool
Maybe LocalizedText
Maybe Text
Maybe Options
editName :: EditApplicationCommand -> Maybe Text
editLocalizedName :: EditApplicationCommand -> Maybe LocalizedText
editDescription :: EditApplicationCommand -> Maybe Text
editLocalizedDescription :: EditApplicationCommand -> Maybe LocalizedText
editOptions :: EditApplicationCommand -> Maybe Options
editDefaultMemberPermissions :: EditApplicationCommand -> Maybe Text
editDMPermission :: EditApplicationCommand -> Maybe Bool
editName :: Maybe Text
editLocalizedName :: Maybe LocalizedText
editDescription :: Maybe Text
editLocalizedDescription :: Maybe LocalizedText
editOptions :: Maybe Options
editDefaultMemberPermissions :: Maybe Text
editDMPermission :: Maybe Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"name" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
editName,
        Key
"name_localization" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
editLocalizedName,
        Key
"description" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
editDescription,
        Key
"description_localization" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
editLocalizedDescription,
        Key
"options" Key -> Maybe Options -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Options
editOptions,
        Key
"default_member_permissions" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
editDefaultMemberPermissions,
        Key
"dm_permission" Key -> Maybe Bool -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Bool
editDMPermission,
        Key
"type" Key -> Value -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
1
      ]
  toJSON EditApplicationCommandUser {Maybe Bool
Maybe LocalizedText
Maybe Text
editName :: EditApplicationCommand -> Maybe Text
editLocalizedName :: EditApplicationCommand -> Maybe LocalizedText
editDefaultMemberPermissions :: EditApplicationCommand -> Maybe Text
editDMPermission :: EditApplicationCommand -> Maybe Bool
editName :: Maybe Text
editLocalizedName :: Maybe LocalizedText
editDefaultMemberPermissions :: Maybe Text
editDMPermission :: Maybe Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"name" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
editName,
        Key
"name_localization" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
editLocalizedName,
        Key
"default_member_permissions" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
editDefaultMemberPermissions,
        Key
"dm_permission" Key -> Maybe Bool -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Bool
editDMPermission,
        Key
"type" Key -> Value -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
2
      ]
  toJSON EditApplicationCommandMessage {Maybe Bool
Maybe LocalizedText
Maybe Text
editName :: EditApplicationCommand -> Maybe Text
editLocalizedName :: EditApplicationCommand -> Maybe LocalizedText
editDefaultMemberPermissions :: EditApplicationCommand -> Maybe Text
editDMPermission :: EditApplicationCommand -> Maybe Bool
editName :: Maybe Text
editLocalizedName :: Maybe LocalizedText
editDefaultMemberPermissions :: Maybe Text
editDMPermission :: Maybe Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"name" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
editName,
        Key
"name_localization" Key -> Maybe LocalizedText -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe LocalizedText
editLocalizedName,
        Key
"default_member_permissions" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
editDefaultMemberPermissions,
        Key
"dm_permission" Key -> Maybe Bool -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Bool
editDMPermission,
        Key
"type" Key -> Value -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
3
      ]

data Choice a = Choice
  { -- | The name of the choice
    forall a. Choice a -> Text
choiceName :: T.Text,
    -- | The localized name of the choice
    forall a. Choice a -> Maybe LocalizedText
choiceLocalizedName :: Maybe LocalizedText,
    -- | The value of the choice
    forall a. 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
$cshowsPrec :: forall a. Show a => Int -> Choice a -> ShowS
showsPrec :: Int -> Choice a -> ShowS
$cshow :: forall a. Show a => Choice a -> String
show :: Choice a -> String
$cshowList :: forall a. Show a => [Choice a] -> ShowS
showList :: [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
$creadsPrec :: forall a. Read a => Int -> ReadS (Choice a)
readsPrec :: Int -> ReadS (Choice a)
$creadList :: forall a. Read a => ReadS [Choice a]
readList :: ReadS [Choice a]
$creadPrec :: forall a. Read a => ReadPrec (Choice a)
readPrec :: ReadPrec (Choice a)
$creadListPrec :: forall a. Read a => ReadPrec [Choice a]
readListPrec :: ReadPrec [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
$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
/= :: Choice a -> Choice a -> Bool
Eq, Eq (Choice a)
Eq (Choice a) =>
(Choice a -> Choice a -> Ordering)
-> (Choice a -> Choice a -> Bool)
-> (Choice a -> Choice a -> Bool)
-> (Choice a -> Choice a -> Bool)
-> (Choice a -> Choice a -> Bool)
-> (Choice a -> Choice a -> Choice a)
-> (Choice a -> Choice a -> Choice a)
-> Ord (Choice a)
Choice a -> Choice a -> Bool
Choice a -> Choice a -> Ordering
Choice a -> Choice a -> Choice a
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
forall a. Ord a => Eq (Choice a)
forall a. Ord a => Choice a -> Choice a -> Bool
forall a. Ord a => Choice a -> Choice a -> Ordering
forall a. Ord a => Choice a -> Choice a -> Choice a
$ccompare :: forall a. Ord a => Choice a -> Choice a -> Ordering
compare :: Choice a -> Choice a -> Ordering
$c< :: forall a. Ord a => Choice a -> Choice a -> Bool
< :: Choice a -> Choice a -> Bool
$c<= :: forall a. Ord a => Choice a -> Choice a -> Bool
<= :: Choice a -> Choice a -> Bool
$c> :: forall a. Ord a => Choice a -> Choice a -> Bool
> :: Choice a -> Choice a -> Bool
$c>= :: forall a. Ord a => Choice a -> Choice a -> Bool
>= :: Choice a -> Choice a -> Bool
$cmax :: forall a. Ord a => Choice a -> Choice a -> Choice a
max :: Choice a -> Choice a -> Choice a
$cmin :: forall a. Ord a => Choice a -> Choice a -> Choice a
min :: Choice a -> Choice a -> Choice a
Ord)

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

instance (ToJSON a) => ToJSON (Choice a) where
  toJSON :: Choice a -> Value
toJSON Choice {a
Maybe LocalizedText
Text
choiceName :: forall a. Choice a -> Text
choiceLocalizedName :: forall a. Choice a -> Maybe LocalizedText
choiceValue :: forall a. Choice a -> a
choiceName :: Text
choiceLocalizedName :: Maybe LocalizedText
choiceValue :: a
..} =
    [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),
        (Key
"name_localizations", Maybe LocalizedText -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe LocalizedText
choiceLocalizedName)
      ]

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 -> Maybe LocalizedText -> a -> Choice a
forall a. Text -> Maybe LocalizedText -> a -> Choice a
Choice
            (Text -> Maybe LocalizedText -> a -> Choice a)
-> Parser Text -> Parser (Maybe LocalizedText -> 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 (Maybe LocalizedText -> a -> Choice a)
-> Parser (Maybe LocalizedText) -> Parser (a -> Choice a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe LocalizedText)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_localizations"
            Parser (a -> Choice a) -> Parser a -> Parser (Choice a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 a. a -> Parser 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 :: forall a. ToJSON a => 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)

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

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
-> ApplicationId
-> GuildId
-> [ApplicationCommandPermissions]
-> GuildApplicationCommandPermissions
GuildApplicationCommandPermissions
            (ApplicationCommandId
 -> ApplicationId
 -> GuildId
 -> [ApplicationCommandPermissions]
 -> GuildApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     (ApplicationId
      -> GuildId
      -> [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
  (ApplicationId
   -> GuildId
   -> [ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser ApplicationId
-> Parser
     (GuildId
      -> [ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
            Parser
  (GuildId
   -> [ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser GuildId
-> Parser
     ([ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
            Parser
  ([ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser [ApplicationCommandPermissions]
-> Parser GuildApplicationCommandPermissions
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
ApplicationId
GuildId
guildApplicationCommandPermissionsId :: GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: GuildApplicationCommandPermissions -> ApplicationId
guildApplicationCommandPermissionsGuildId :: GuildApplicationCommandPermissions -> GuildId
guildApplicationCommandPermissionsPermissions :: GuildApplicationCommandPermissions
-> [ApplicationCommandPermissions]
guildApplicationCommandPermissionsId :: ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: ApplicationId
guildApplicationCommandPermissionsGuildId :: GuildId
guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"id" Key -> ApplicationCommandId -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== ApplicationCommandId
guildApplicationCommandPermissionsId,
        Key
"application_id" Key -> ApplicationId -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== ApplicationId
guildApplicationCommandPermissionsApplicationId,
        Key
"guild_id" Key -> GuildId -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== GuildId
guildApplicationCommandPermissionsGuildId,
        Key
"permissions" Key -> [ApplicationCommandPermissions] -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== [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 -> Snowflake
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
$cshowsPrec :: Int -> ApplicationCommandPermissions -> ShowS
showsPrec :: Int -> ApplicationCommandPermissions -> ShowS
$cshow :: ApplicationCommandPermissions -> String
show :: ApplicationCommandPermissions -> String
$cshowList :: [ApplicationCommandPermissions] -> ShowS
showList :: [ApplicationCommandPermissions] -> ShowS
Show, 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
$creadsPrec :: Int -> ReadS ApplicationCommandPermissions
readsPrec :: Int -> ReadS ApplicationCommandPermissions
$creadList :: ReadS [ApplicationCommandPermissions]
readList :: ReadS [ApplicationCommandPermissions]
$creadPrec :: ReadPrec ApplicationCommandPermissions
readPrec :: ReadPrec ApplicationCommandPermissions
$creadListPrec :: ReadPrec [ApplicationCommandPermissions]
readListPrec :: ReadPrec [ApplicationCommandPermissions]
Read, ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
(ApplicationCommandPermissions
 -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> Eq ApplicationCommandPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
== :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c/= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
/= :: 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
$ccompare :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
compare :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
$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
>= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$cmax :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
max :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
$cmin :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
min :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
Ord)

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 ->
          Snowflake -> Integer -> Bool -> ApplicationCommandPermissions
ApplicationCommandPermissions
            (Snowflake -> Integer -> Bool -> ApplicationCommandPermissions)
-> Parser Snowflake
-> Parser (Integer -> Bool -> ApplicationCommandPermissions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Snowflake
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser (Integer -> Bool -> ApplicationCommandPermissions)
-> Parser Integer -> Parser (Bool -> ApplicationCommandPermissions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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
Snowflake
applicationCommandPermissionsId :: ApplicationCommandPermissions -> Snowflake
applicationCommandPermissionsType :: ApplicationCommandPermissions -> Integer
applicationCommandPermissionsPermission :: ApplicationCommandPermissions -> Bool
applicationCommandPermissionsId :: Snowflake
applicationCommandPermissionsType :: Integer
applicationCommandPermissionsPermission :: Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"id" Key -> Snowflake -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Snowflake
applicationCommandPermissionsId,
        Key
"type" Key -> Integer -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Integer
applicationCommandPermissionsType,
        Key
"permission" Key -> Bool -> Maybe Pair
forall a. ToJSON a => Key -> a -> Maybe Pair
.== Bool
applicationCommandPermissionsPermission
      ]

-- | A discord locale. See
-- <https://discord.com/developers/docs/reference#locales> for available locales
type Locale = T.Text

-- | Translations for a text
type LocalizedText = Map Locale T.Text