{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Discord.Internal.Types.Components
  ( ComponentActionRow (..),
    ComponentButton (..),
    ButtonStyle (..),
    mkButton,
    ComponentSelectMenu (..),
    mkSelectMenu,
    SelectOption (..),
    mkSelectOption,
    ComponentTextInput (..),
    mkComponentTextInput,
  )
where

import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Foldable (Foldable (toList))
import Data.Scientific (Scientific)
import qualified Data.Text as T
import Discord.Internal.Types.Emoji (Emoji)
import Discord.Internal.Types.Prelude (toMaybeJSON)

data ComponentActionRow = ComponentActionRowButton [ComponentButton] | ComponentActionRowSelectMenu ComponentSelectMenu
  deriving (Int -> ComponentActionRow -> ShowS
[ComponentActionRow] -> ShowS
ComponentActionRow -> String
(Int -> ComponentActionRow -> ShowS)
-> (ComponentActionRow -> String)
-> ([ComponentActionRow] -> ShowS)
-> Show ComponentActionRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentActionRow] -> ShowS
$cshowList :: [ComponentActionRow] -> ShowS
show :: ComponentActionRow -> String
$cshow :: ComponentActionRow -> String
showsPrec :: Int -> ComponentActionRow -> ShowS
$cshowsPrec :: Int -> ComponentActionRow -> ShowS
Show, ReadPrec [ComponentActionRow]
ReadPrec ComponentActionRow
Int -> ReadS ComponentActionRow
ReadS [ComponentActionRow]
(Int -> ReadS ComponentActionRow)
-> ReadS [ComponentActionRow]
-> ReadPrec ComponentActionRow
-> ReadPrec [ComponentActionRow]
-> Read ComponentActionRow
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentActionRow]
$creadListPrec :: ReadPrec [ComponentActionRow]
readPrec :: ReadPrec ComponentActionRow
$creadPrec :: ReadPrec ComponentActionRow
readList :: ReadS [ComponentActionRow]
$creadList :: ReadS [ComponentActionRow]
readsPrec :: Int -> ReadS ComponentActionRow
$creadsPrec :: Int -> ReadS ComponentActionRow
Read, ComponentActionRow -> ComponentActionRow -> Bool
(ComponentActionRow -> ComponentActionRow -> Bool)
-> (ComponentActionRow -> ComponentActionRow -> Bool)
-> Eq ComponentActionRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentActionRow -> ComponentActionRow -> Bool
$c/= :: ComponentActionRow -> ComponentActionRow -> Bool
== :: ComponentActionRow -> ComponentActionRow -> Bool
$c== :: ComponentActionRow -> ComponentActionRow -> Bool
Eq, Eq ComponentActionRow
Eq ComponentActionRow
-> (ComponentActionRow -> ComponentActionRow -> Ordering)
-> (ComponentActionRow -> ComponentActionRow -> Bool)
-> (ComponentActionRow -> ComponentActionRow -> Bool)
-> (ComponentActionRow -> ComponentActionRow -> Bool)
-> (ComponentActionRow -> ComponentActionRow -> Bool)
-> (ComponentActionRow -> ComponentActionRow -> ComponentActionRow)
-> (ComponentActionRow -> ComponentActionRow -> ComponentActionRow)
-> Ord ComponentActionRow
ComponentActionRow -> ComponentActionRow -> Bool
ComponentActionRow -> ComponentActionRow -> Ordering
ComponentActionRow -> ComponentActionRow -> ComponentActionRow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentActionRow -> ComponentActionRow -> ComponentActionRow
$cmin :: ComponentActionRow -> ComponentActionRow -> ComponentActionRow
max :: ComponentActionRow -> ComponentActionRow -> ComponentActionRow
$cmax :: ComponentActionRow -> ComponentActionRow -> ComponentActionRow
>= :: ComponentActionRow -> ComponentActionRow -> Bool
$c>= :: ComponentActionRow -> ComponentActionRow -> Bool
> :: ComponentActionRow -> ComponentActionRow -> Bool
$c> :: ComponentActionRow -> ComponentActionRow -> Bool
<= :: ComponentActionRow -> ComponentActionRow -> Bool
$c<= :: ComponentActionRow -> ComponentActionRow -> Bool
< :: ComponentActionRow -> ComponentActionRow -> Bool
$c< :: ComponentActionRow -> ComponentActionRow -> Bool
compare :: ComponentActionRow -> ComponentActionRow -> Ordering
$ccompare :: ComponentActionRow -> ComponentActionRow -> Ordering
$cp1Ord :: Eq ComponentActionRow
Ord)

instance FromJSON ComponentActionRow where
  parseJSON :: Value -> Parser ComponentActionRow
parseJSON =
    String
-> (Object -> Parser ComponentActionRow)
-> Value
-> Parser ComponentActionRow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ComponentActionRow"
      ( \Object
cs -> do
          Int
t <- Object
cs Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 -> do
              Array
a <- Object
cs Object -> Key -> Parser Array
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components" :: Parser Array
              let a' :: [Value]
a' = Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
              case [Value]
a' of
                [] -> ComponentActionRow -> Parser ComponentActionRow
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentActionRow -> Parser ComponentActionRow)
-> ComponentActionRow -> Parser ComponentActionRow
forall a b. (a -> b) -> a -> b
$ [ComponentButton] -> ComponentActionRow
ComponentActionRowButton []
                (Value
c : [Value]
_) ->
                  String
-> (Object -> Parser ComponentActionRow)
-> Value
-> Parser ComponentActionRow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
                    String
"ComponentActionRow item"
                    ( \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 -> [ComponentButton] -> ComponentActionRow
ComponentActionRowButton ([ComponentButton] -> ComponentActionRow)
-> Parser [ComponentButton] -> Parser ComponentActionRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser ComponentButton)
-> [Value] -> Parser [ComponentButton]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser ComponentButton
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                          Int
3 -> ComponentSelectMenu -> ComponentActionRow
ComponentActionRowSelectMenu (ComponentSelectMenu -> ComponentActionRow)
-> Parser ComponentSelectMenu -> Parser ComponentActionRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ComponentSelectMenu
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c
                          Int
_ -> String -> Parser ComponentActionRow
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ComponentActionRow)
-> String -> Parser ComponentActionRow
forall a b. (a -> b) -> a -> b
$ String
"unknown component type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t
                    )
                    Value
c
            Int
_ -> String -> Parser ComponentActionRow
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ComponentActionRow)
-> String -> Parser ComponentActionRow
forall a b. (a -> b) -> a -> b
$ String
"expected action row type (1), got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t
      )

instance ToJSON ComponentActionRow where
  toJSON :: ComponentActionRow -> Value
toJSON (ComponentActionRowButton [ComponentButton]
bs) = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
1), (Key
"components", [ComponentButton] -> Value
forall a. ToJSON a => a -> Value
toJSON [ComponentButton]
bs)]
  toJSON (ComponentActionRowSelectMenu ComponentSelectMenu
bs) = [Pair] -> Value
object [(Key
"type", Scientific -> Value
Number Scientific
1), (Key
"components", [ComponentSelectMenu] -> Value
forall a. ToJSON a => a -> Value
toJSON [ComponentSelectMenu
bs])]

-- | Component type for a button, split into URL button and not URL button.
--
-- Don't directly send button components - they need to be within an action row.
data ComponentButton
  = ComponentButton
      { -- | Dev indentifier
        ComponentButton -> Text
componentButtonCustomId :: T.Text,
        -- | Whether the button is disabled
        ComponentButton -> Bool
componentButtonDisabled :: Bool,
        -- | What is the style of the button
        ComponentButton -> ButtonStyle
componentButtonStyle :: ButtonStyle,
        -- | What is the user-facing label of the button
        ComponentButton -> Maybe Text
componentButtonLabel :: Maybe T.Text,
        -- | What emoji is displayed on the button
        ComponentButton -> Maybe Emoji
componentButtonEmoji :: Maybe Emoji
      }
  | ComponentButtonUrl
      { -- | The url for the button. If this is not a valid url, everything will
        -- break
        ComponentButton -> Text
componentButtonUrl :: T.Text,
        -- | Whether the button is disabled
        componentButtonDisabled :: Bool,
        -- | What is the user-facing label of the button
        componentButtonLabel :: Maybe T.Text,
        -- | What emoji is displayed on the button
        componentButtonEmoji :: Maybe Emoji
      }
  deriving (Int -> ComponentButton -> ShowS
[ComponentButton] -> ShowS
ComponentButton -> String
(Int -> ComponentButton -> ShowS)
-> (ComponentButton -> String)
-> ([ComponentButton] -> ShowS)
-> Show ComponentButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentButton] -> ShowS
$cshowList :: [ComponentButton] -> ShowS
show :: ComponentButton -> String
$cshow :: ComponentButton -> String
showsPrec :: Int -> ComponentButton -> ShowS
$cshowsPrec :: Int -> ComponentButton -> ShowS
Show, ReadPrec [ComponentButton]
ReadPrec ComponentButton
Int -> ReadS ComponentButton
ReadS [ComponentButton]
(Int -> ReadS ComponentButton)
-> ReadS [ComponentButton]
-> ReadPrec ComponentButton
-> ReadPrec [ComponentButton]
-> Read ComponentButton
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentButton]
$creadListPrec :: ReadPrec [ComponentButton]
readPrec :: ReadPrec ComponentButton
$creadPrec :: ReadPrec ComponentButton
readList :: ReadS [ComponentButton]
$creadList :: ReadS [ComponentButton]
readsPrec :: Int -> ReadS ComponentButton
$creadsPrec :: Int -> ReadS ComponentButton
Read, ComponentButton -> ComponentButton -> Bool
(ComponentButton -> ComponentButton -> Bool)
-> (ComponentButton -> ComponentButton -> Bool)
-> Eq ComponentButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentButton -> ComponentButton -> Bool
$c/= :: ComponentButton -> ComponentButton -> Bool
== :: ComponentButton -> ComponentButton -> Bool
$c== :: ComponentButton -> ComponentButton -> Bool
Eq, Eq ComponentButton
Eq ComponentButton
-> (ComponentButton -> ComponentButton -> Ordering)
-> (ComponentButton -> ComponentButton -> Bool)
-> (ComponentButton -> ComponentButton -> Bool)
-> (ComponentButton -> ComponentButton -> Bool)
-> (ComponentButton -> ComponentButton -> Bool)
-> (ComponentButton -> ComponentButton -> ComponentButton)
-> (ComponentButton -> ComponentButton -> ComponentButton)
-> Ord ComponentButton
ComponentButton -> ComponentButton -> Bool
ComponentButton -> ComponentButton -> Ordering
ComponentButton -> ComponentButton -> ComponentButton
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentButton -> ComponentButton -> ComponentButton
$cmin :: ComponentButton -> ComponentButton -> ComponentButton
max :: ComponentButton -> ComponentButton -> ComponentButton
$cmax :: ComponentButton -> ComponentButton -> ComponentButton
>= :: ComponentButton -> ComponentButton -> Bool
$c>= :: ComponentButton -> ComponentButton -> Bool
> :: ComponentButton -> ComponentButton -> Bool
$c> :: ComponentButton -> ComponentButton -> Bool
<= :: ComponentButton -> ComponentButton -> Bool
$c<= :: ComponentButton -> ComponentButton -> Bool
< :: ComponentButton -> ComponentButton -> Bool
$c< :: ComponentButton -> ComponentButton -> Bool
compare :: ComponentButton -> ComponentButton -> Ordering
$ccompare :: ComponentButton -> ComponentButton -> Ordering
$cp1Ord :: Eq ComponentButton
Ord)

-- | Takes the label and the custom id of the button that is to be generated.
mkButton :: T.Text -> T.Text -> ComponentButton
mkButton :: Text -> Text -> ComponentButton
mkButton Text
label Text
customId = Text
-> Bool
-> ButtonStyle
-> Maybe Text
-> Maybe Emoji
-> ComponentButton
ComponentButton Text
customId Bool
False ButtonStyle
ButtonStyleSecondary (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
label) Maybe Emoji
forall a. Maybe a
Nothing

instance FromJSON ComponentButton where
  parseJSON :: Value -> Parser ComponentButton
parseJSON =
    String
-> (Object -> Parser ComponentButton)
-> Value
-> Parser ComponentButton
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ComponentButton"
      ( \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 -> do
              Bool
disabled <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disabled" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
              Maybe Text
label <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label"
              Maybe Emoji
partialEmoji <- Object
v Object -> Key -> Parser (Maybe Emoji)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
              Scientific
style <- Object
v Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"style" :: Parser Scientific
              case Scientific
style of
                Scientific
5 ->
                  Text -> Bool -> Maybe Text -> Maybe Emoji -> ComponentButton
ComponentButtonUrl
                    (Text -> Bool -> Maybe Text -> Maybe Emoji -> ComponentButton)
-> Parser Text
-> Parser (Bool -> Maybe Text -> Maybe Emoji -> ComponentButton)
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
"url"
                    Parser (Bool -> Maybe Text -> Maybe Emoji -> ComponentButton)
-> Parser Bool
-> Parser (Maybe Text -> Maybe Emoji -> ComponentButton)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
disabled
                    Parser (Maybe Text -> Maybe Emoji -> ComponentButton)
-> Parser (Maybe Text) -> Parser (Maybe Emoji -> ComponentButton)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
label
                    Parser (Maybe Emoji -> ComponentButton)
-> Parser (Maybe Emoji) -> Parser ComponentButton
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Emoji -> Parser (Maybe Emoji)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Emoji
partialEmoji
                Scientific
_ ->
                  Text
-> Bool
-> ButtonStyle
-> Maybe Text
-> Maybe Emoji
-> ComponentButton
ComponentButton
                    (Text
 -> Bool
 -> ButtonStyle
 -> Maybe Text
 -> Maybe Emoji
 -> ComponentButton)
-> Parser Text
-> Parser
     (Bool
      -> ButtonStyle -> Maybe Text -> Maybe Emoji -> ComponentButton)
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
"custom_id"
                    Parser
  (Bool
   -> ButtonStyle -> Maybe Text -> Maybe Emoji -> ComponentButton)
-> Parser Bool
-> Parser
     (ButtonStyle -> Maybe Text -> Maybe Emoji -> ComponentButton)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
disabled
                    Parser
  (ButtonStyle -> Maybe Text -> Maybe Emoji -> ComponentButton)
-> Parser ButtonStyle
-> Parser (Maybe Text -> Maybe Emoji -> ComponentButton)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ButtonStyle
forall a. FromJSON a => Value -> Parser a
parseJSON (Scientific -> Value
Number Scientific
style)
                    Parser (Maybe Text -> Maybe Emoji -> ComponentButton)
-> Parser (Maybe Text) -> Parser (Maybe Emoji -> ComponentButton)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
label
                    Parser (Maybe Emoji -> ComponentButton)
-> Parser (Maybe Emoji) -> Parser ComponentButton
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Emoji -> Parser (Maybe Emoji)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Emoji
partialEmoji
            Int
_ -> String -> Parser ComponentButton
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected button type, got a different component"
      )

instance ToJSON ComponentButton where
  toJSON :: ComponentButton -> Value
toJSON ComponentButtonUrl {Bool
Maybe Text
Maybe Emoji
Text
componentButtonEmoji :: Maybe Emoji
componentButtonLabel :: Maybe Text
componentButtonDisabled :: Bool
componentButtonUrl :: Text
componentButtonUrl :: ComponentButton -> Text
componentButtonEmoji :: ComponentButton -> Maybe Emoji
componentButtonLabel :: ComponentButton -> Maybe Text
componentButtonDisabled :: ComponentButton -> Bool
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
2),
              (Key
"style", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
5),
              (Key
"label", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
componentButtonLabel),
              (Key
"disabled", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
componentButtonDisabled),
              (Key
"url", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
componentButtonUrl),
              (Key
"emoji", Emoji -> Value
forall a. ToJSON a => a -> Value
toJSON (Emoji -> Value) -> Maybe Emoji -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Emoji
componentButtonEmoji)
            ]
      ]
  toJSON ComponentButton {Bool
Maybe Text
Maybe Emoji
Text
ButtonStyle
componentButtonEmoji :: Maybe Emoji
componentButtonLabel :: Maybe Text
componentButtonStyle :: ButtonStyle
componentButtonDisabled :: Bool
componentButtonCustomId :: Text
componentButtonEmoji :: ComponentButton -> Maybe Emoji
componentButtonLabel :: ComponentButton -> Maybe Text
componentButtonStyle :: ComponentButton -> ButtonStyle
componentButtonDisabled :: ComponentButton -> Bool
componentButtonCustomId :: ComponentButton -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
2),
              (Key
"style", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ButtonStyle -> Value
forall a. ToJSON a => a -> Value
toJSON ButtonStyle
componentButtonStyle),
              (Key
"label", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
componentButtonLabel),
              (Key
"disabled", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
componentButtonDisabled),
              (Key
"custom_id", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
componentButtonCustomId),
              (Key
"emoji", Emoji -> Value
forall a. ToJSON a => a -> Value
toJSON (Emoji -> Value) -> Maybe Emoji -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Emoji
componentButtonEmoji)
            ]
      ]

-- | Buttton colors.
data ButtonStyle
  = -- | Blurple button
    ButtonStylePrimary
  | -- | Grey button
    ButtonStyleSecondary
  | -- | Green button
    ButtonStyleSuccess
  | -- | Red button
    ButtonStyleDanger
  deriving (Int -> ButtonStyle -> ShowS
[ButtonStyle] -> ShowS
ButtonStyle -> String
(Int -> ButtonStyle -> ShowS)
-> (ButtonStyle -> String)
-> ([ButtonStyle] -> ShowS)
-> Show ButtonStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ButtonStyle] -> ShowS
$cshowList :: [ButtonStyle] -> ShowS
show :: ButtonStyle -> String
$cshow :: ButtonStyle -> String
showsPrec :: Int -> ButtonStyle -> ShowS
$cshowsPrec :: Int -> ButtonStyle -> ShowS
Show, ReadPrec [ButtonStyle]
ReadPrec ButtonStyle
Int -> ReadS ButtonStyle
ReadS [ButtonStyle]
(Int -> ReadS ButtonStyle)
-> ReadS [ButtonStyle]
-> ReadPrec ButtonStyle
-> ReadPrec [ButtonStyle]
-> Read ButtonStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ButtonStyle]
$creadListPrec :: ReadPrec [ButtonStyle]
readPrec :: ReadPrec ButtonStyle
$creadPrec :: ReadPrec ButtonStyle
readList :: ReadS [ButtonStyle]
$creadList :: ReadS [ButtonStyle]
readsPrec :: Int -> ReadS ButtonStyle
$creadsPrec :: Int -> ReadS ButtonStyle
Read, ButtonStyle -> ButtonStyle -> Bool
(ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool) -> Eq ButtonStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ButtonStyle -> ButtonStyle -> Bool
$c/= :: ButtonStyle -> ButtonStyle -> Bool
== :: ButtonStyle -> ButtonStyle -> Bool
$c== :: ButtonStyle -> ButtonStyle -> Bool
Eq, Eq ButtonStyle
Eq ButtonStyle
-> (ButtonStyle -> ButtonStyle -> Ordering)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> ButtonStyle)
-> (ButtonStyle -> ButtonStyle -> ButtonStyle)
-> Ord ButtonStyle
ButtonStyle -> ButtonStyle -> Bool
ButtonStyle -> ButtonStyle -> Ordering
ButtonStyle -> ButtonStyle -> ButtonStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ButtonStyle -> ButtonStyle -> ButtonStyle
$cmin :: ButtonStyle -> ButtonStyle -> ButtonStyle
max :: ButtonStyle -> ButtonStyle -> ButtonStyle
$cmax :: ButtonStyle -> ButtonStyle -> ButtonStyle
>= :: ButtonStyle -> ButtonStyle -> Bool
$c>= :: ButtonStyle -> ButtonStyle -> Bool
> :: ButtonStyle -> ButtonStyle -> Bool
$c> :: ButtonStyle -> ButtonStyle -> Bool
<= :: ButtonStyle -> ButtonStyle -> Bool
$c<= :: ButtonStyle -> ButtonStyle -> Bool
< :: ButtonStyle -> ButtonStyle -> Bool
$c< :: ButtonStyle -> ButtonStyle -> Bool
compare :: ButtonStyle -> ButtonStyle -> Ordering
$ccompare :: ButtonStyle -> ButtonStyle -> Ordering
$cp1Ord :: Eq ButtonStyle
Ord)

instance FromJSON ButtonStyle where
  parseJSON :: Value -> Parser ButtonStyle
parseJSON =
    String
-> (Scientific -> Parser ButtonStyle)
-> Value
-> Parser ButtonStyle
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific
      String
"ButtonStyle"
      ( \case
          Scientific
1 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStylePrimary
          Scientific
2 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStyleSecondary
          Scientific
3 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStyleSuccess
          Scientific
4 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStyleDanger
          Scientific
_ -> String -> Parser ButtonStyle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unrecognised non-url button style"
      )

instance ToJSON ButtonStyle where
  toJSON :: ButtonStyle -> Value
toJSON ButtonStyle
ButtonStylePrimary = Scientific -> Value
Number Scientific
1
  toJSON ButtonStyle
ButtonStyleSecondary = Scientific -> Value
Number Scientific
2
  toJSON ButtonStyle
ButtonStyleSuccess = Scientific -> Value
Number Scientific
3
  toJSON ButtonStyle
ButtonStyleDanger = Scientific -> Value
Number Scientific
4

-- | Component type for a select menus.
--
-- Don't directly send select menus - they need to be within an action row.
data ComponentSelectMenu = ComponentSelectMenu
  { -- | Dev identifier
    ComponentSelectMenu -> Text
componentSelectMenuCustomId :: T.Text,
    -- | Whether the select menu is disabled
    ComponentSelectMenu -> Bool
componentSelectMenuDisabled :: Bool,
    -- | What options are in this select menu (up to 25)
    ComponentSelectMenu -> [SelectOption]
componentSelectMenuOptions :: [SelectOption],
    -- | Placeholder text if nothing is selected
    ComponentSelectMenu -> Maybe Text
componentSelectMenuPlaceholder :: Maybe T.Text,
    -- | Minimum number of values to select (def 1, min 0, max 25)
    ComponentSelectMenu -> Maybe Integer
componentSelectMenuMinValues :: Maybe Integer,
    -- | Maximum number of values to select (def 1, max 25)
    ComponentSelectMenu -> Maybe Integer
componentSelectMenuMaxValues :: Maybe Integer
  }
  deriving (Int -> ComponentSelectMenu -> ShowS
[ComponentSelectMenu] -> ShowS
ComponentSelectMenu -> String
(Int -> ComponentSelectMenu -> ShowS)
-> (ComponentSelectMenu -> String)
-> ([ComponentSelectMenu] -> ShowS)
-> Show ComponentSelectMenu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentSelectMenu] -> ShowS
$cshowList :: [ComponentSelectMenu] -> ShowS
show :: ComponentSelectMenu -> String
$cshow :: ComponentSelectMenu -> String
showsPrec :: Int -> ComponentSelectMenu -> ShowS
$cshowsPrec :: Int -> ComponentSelectMenu -> ShowS
Show, ReadPrec [ComponentSelectMenu]
ReadPrec ComponentSelectMenu
Int -> ReadS ComponentSelectMenu
ReadS [ComponentSelectMenu]
(Int -> ReadS ComponentSelectMenu)
-> ReadS [ComponentSelectMenu]
-> ReadPrec ComponentSelectMenu
-> ReadPrec [ComponentSelectMenu]
-> Read ComponentSelectMenu
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentSelectMenu]
$creadListPrec :: ReadPrec [ComponentSelectMenu]
readPrec :: ReadPrec ComponentSelectMenu
$creadPrec :: ReadPrec ComponentSelectMenu
readList :: ReadS [ComponentSelectMenu]
$creadList :: ReadS [ComponentSelectMenu]
readsPrec :: Int -> ReadS ComponentSelectMenu
$creadsPrec :: Int -> ReadS ComponentSelectMenu
Read, ComponentSelectMenu -> ComponentSelectMenu -> Bool
(ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> (ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> Eq ComponentSelectMenu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c/= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
== :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c== :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
Eq, Eq ComponentSelectMenu
Eq ComponentSelectMenu
-> (ComponentSelectMenu -> ComponentSelectMenu -> Ordering)
-> (ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> (ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> (ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> (ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> (ComponentSelectMenu
    -> ComponentSelectMenu -> ComponentSelectMenu)
-> (ComponentSelectMenu
    -> ComponentSelectMenu -> ComponentSelectMenu)
-> Ord ComponentSelectMenu
ComponentSelectMenu -> ComponentSelectMenu -> Bool
ComponentSelectMenu -> ComponentSelectMenu -> Ordering
ComponentSelectMenu -> ComponentSelectMenu -> ComponentSelectMenu
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentSelectMenu -> ComponentSelectMenu -> ComponentSelectMenu
$cmin :: ComponentSelectMenu -> ComponentSelectMenu -> ComponentSelectMenu
max :: ComponentSelectMenu -> ComponentSelectMenu -> ComponentSelectMenu
$cmax :: ComponentSelectMenu -> ComponentSelectMenu -> ComponentSelectMenu
>= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c>= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
> :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c> :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
<= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c<= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
< :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c< :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
compare :: ComponentSelectMenu -> ComponentSelectMenu -> Ordering
$ccompare :: ComponentSelectMenu -> ComponentSelectMenu -> Ordering
$cp1Ord :: Eq ComponentSelectMenu
Ord)

-- | Takes the custom id and the options of the select menu that is to be
-- generated.
mkSelectMenu :: T.Text -> [SelectOption] -> ComponentSelectMenu
mkSelectMenu :: Text -> [SelectOption] -> ComponentSelectMenu
mkSelectMenu Text
customId [SelectOption]
sos = Text
-> Bool
-> [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> ComponentSelectMenu
ComponentSelectMenu Text
customId Bool
False [SelectOption]
sos Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

instance FromJSON ComponentSelectMenu where
  parseJSON :: Value -> Parser ComponentSelectMenu
parseJSON =
    String
-> (Object -> Parser ComponentSelectMenu)
-> Value
-> Parser ComponentSelectMenu
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ComponentSelectMenu"
      ( \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
3 ->
                Text
-> Bool
-> [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> ComponentSelectMenu
ComponentSelectMenu
                  (Text
 -> Bool
 -> [SelectOption]
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Integer
 -> ComponentSelectMenu)
-> Parser Text
-> Parser
     (Bool
      -> [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> ComponentSelectMenu)
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
"custom_id"
                  Parser
  (Bool
   -> [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> ComponentSelectMenu)
-> Parser Bool
-> Parser
     ([SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> ComponentSelectMenu)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disabled" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
                  Parser
  ([SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> ComponentSelectMenu)
-> Parser [SelectOption]
-> Parser
     (Maybe Text
      -> Maybe Integer -> Maybe Integer -> ComponentSelectMenu)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [SelectOption]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"options"
                  Parser
  (Maybe Text
   -> Maybe Integer -> Maybe Integer -> ComponentSelectMenu)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Integer -> ComponentSelectMenu)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"placeholder"
                  Parser (Maybe Integer -> Maybe Integer -> ComponentSelectMenu)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> ComponentSelectMenu)
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_values"
                  Parser (Maybe Integer -> ComponentSelectMenu)
-> Parser (Maybe Integer) -> Parser ComponentSelectMenu
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_values"
              Int
_ -> String -> Parser ComponentSelectMenu
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected select menu type, got different component"
      )

instance ToJSON ComponentSelectMenu where
  toJSON :: ComponentSelectMenu -> Value
toJSON ComponentSelectMenu {Bool
[SelectOption]
Maybe Integer
Maybe Text
Text
componentSelectMenuMaxValues :: Maybe Integer
componentSelectMenuMinValues :: Maybe Integer
componentSelectMenuPlaceholder :: Maybe Text
componentSelectMenuOptions :: [SelectOption]
componentSelectMenuDisabled :: Bool
componentSelectMenuCustomId :: Text
componentSelectMenuMaxValues :: ComponentSelectMenu -> Maybe Integer
componentSelectMenuMinValues :: ComponentSelectMenu -> Maybe Integer
componentSelectMenuPlaceholder :: ComponentSelectMenu -> Maybe Text
componentSelectMenuOptions :: ComponentSelectMenu -> [SelectOption]
componentSelectMenuDisabled :: ComponentSelectMenu -> Bool
componentSelectMenuCustomId :: ComponentSelectMenu -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
3),
              (Key
"custom_id", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
componentSelectMenuCustomId),
              (Key
"disabled", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
componentSelectMenuDisabled),
              (Key
"options", [SelectOption] -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON [SelectOption]
componentSelectMenuOptions),
              (Key
"placeholder", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
componentSelectMenuPlaceholder),
              (Key
"min_values", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
componentSelectMenuMinValues),
              (Key
"max_values", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
componentSelectMenuMaxValues)
            ]
      ]

-- | A single option in a select menu.
data SelectOption = SelectOption
  { -- | User facing option name
    SelectOption -> Text
selectOptionLabel :: T.Text,
    -- | Dev facing option value
    SelectOption -> Text
selectOptionValue :: T.Text,
    -- | additional description
    SelectOption -> Maybe Text
selectOptionDescription :: Maybe T.Text,
    -- | A partial emoji to show with the object (id, name, animated)
    SelectOption -> Maybe Emoji
selectOptionEmoji :: Maybe Emoji,
    -- | Use this value by default
    SelectOption -> Maybe Bool
selectOptionDefault :: Maybe Bool
  }
  deriving (Int -> SelectOption -> ShowS
[SelectOption] -> ShowS
SelectOption -> String
(Int -> SelectOption -> ShowS)
-> (SelectOption -> String)
-> ([SelectOption] -> ShowS)
-> Show SelectOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectOption] -> ShowS
$cshowList :: [SelectOption] -> ShowS
show :: SelectOption -> String
$cshow :: SelectOption -> String
showsPrec :: Int -> SelectOption -> ShowS
$cshowsPrec :: Int -> SelectOption -> ShowS
Show, ReadPrec [SelectOption]
ReadPrec SelectOption
Int -> ReadS SelectOption
ReadS [SelectOption]
(Int -> ReadS SelectOption)
-> ReadS [SelectOption]
-> ReadPrec SelectOption
-> ReadPrec [SelectOption]
-> Read SelectOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SelectOption]
$creadListPrec :: ReadPrec [SelectOption]
readPrec :: ReadPrec SelectOption
$creadPrec :: ReadPrec SelectOption
readList :: ReadS [SelectOption]
$creadList :: ReadS [SelectOption]
readsPrec :: Int -> ReadS SelectOption
$creadsPrec :: Int -> ReadS SelectOption
Read, SelectOption -> SelectOption -> Bool
(SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool) -> Eq SelectOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectOption -> SelectOption -> Bool
$c/= :: SelectOption -> SelectOption -> Bool
== :: SelectOption -> SelectOption -> Bool
$c== :: SelectOption -> SelectOption -> Bool
Eq, Eq SelectOption
Eq SelectOption
-> (SelectOption -> SelectOption -> Ordering)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> SelectOption)
-> (SelectOption -> SelectOption -> SelectOption)
-> Ord SelectOption
SelectOption -> SelectOption -> Bool
SelectOption -> SelectOption -> Ordering
SelectOption -> SelectOption -> SelectOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SelectOption -> SelectOption -> SelectOption
$cmin :: SelectOption -> SelectOption -> SelectOption
max :: SelectOption -> SelectOption -> SelectOption
$cmax :: SelectOption -> SelectOption -> SelectOption
>= :: SelectOption -> SelectOption -> Bool
$c>= :: SelectOption -> SelectOption -> Bool
> :: SelectOption -> SelectOption -> Bool
$c> :: SelectOption -> SelectOption -> Bool
<= :: SelectOption -> SelectOption -> Bool
$c<= :: SelectOption -> SelectOption -> Bool
< :: SelectOption -> SelectOption -> Bool
$c< :: SelectOption -> SelectOption -> Bool
compare :: SelectOption -> SelectOption -> Ordering
$ccompare :: SelectOption -> SelectOption -> Ordering
$cp1Ord :: Eq SelectOption
Ord)

-- | Make a select option from the given label and value.
mkSelectOption :: T.Text -> T.Text -> SelectOption
mkSelectOption :: Text -> Text -> SelectOption
mkSelectOption Text
label Text
value = Text
-> Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption
SelectOption Text
label Text
value Maybe Text
forall a. Maybe a
Nothing Maybe Emoji
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

instance FromJSON SelectOption where
  parseJSON :: Value -> Parser SelectOption
parseJSON = String
-> (Object -> Parser SelectOption) -> Value -> Parser SelectOption
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SelectOption" ((Object -> Parser SelectOption) -> Value -> Parser SelectOption)
-> (Object -> Parser SelectOption) -> Value -> Parser SelectOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption
SelectOption (Text
 -> Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser Text
-> Parser
     (Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label"
      Parser
  (Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser Text
-> Parser (Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Parser (Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser (Maybe Text)
-> Parser (Maybe Emoji -> Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser (Maybe Emoji) -> Parser (Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Emoji)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
      Parser (Maybe Bool -> SelectOption)
-> Parser (Maybe Bool) -> Parser SelectOption
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default"

instance ToJSON SelectOption where
  toJSON :: SelectOption -> Value
toJSON SelectOption {Maybe Bool
Maybe Text
Maybe Emoji
Text
selectOptionDefault :: Maybe Bool
selectOptionEmoji :: Maybe Emoji
selectOptionDescription :: Maybe Text
selectOptionValue :: Text
selectOptionLabel :: Text
selectOptionDefault :: SelectOption -> Maybe Bool
selectOptionEmoji :: SelectOption -> Maybe Emoji
selectOptionDescription :: SelectOption -> Maybe Text
selectOptionValue :: SelectOption -> Text
selectOptionLabel :: SelectOption -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"label", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
selectOptionLabel),
              (Key
"value", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
selectOptionValue),
              (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
selectOptionDescription),
              (Key
"emoji", Emoji -> Value
forall a. ToJSON a => a -> Value
toJSON (Emoji -> Value) -> Maybe Emoji -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Emoji
selectOptionEmoji),
              (Key
"default", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
selectOptionDefault)
            ]
      ]

data ComponentTextInput = ComponentTextInput
  { -- | Dev identifier
    ComponentTextInput -> Text
componentTextInputCustomId :: T.Text,
    -- | What style to use (short or paragraph)
    ComponentTextInput -> Bool
componentTextInputIsParagraph :: Bool,
    -- | The label for this component
    ComponentTextInput -> Text
componentTextInputLabel :: T.Text,
    -- | The minimum input length for a text input (0-4000)
    ComponentTextInput -> Maybe Integer
componentTextInputMinLength :: Maybe Integer,
    -- | The maximum input length for a text input (1-4000)
    ComponentTextInput -> Maybe Integer
componentTextInputMaxLength :: Maybe Integer,
    -- | Whether this component is required to be filled
    ComponentTextInput -> Bool
componentTextInputRequired :: Bool,
    -- | The prefilled value for this component (max 4000)
    ComponentTextInput -> Text
componentTextInputValue :: T.Text,
    -- | Placeholder text if empty (max 4000)
    ComponentTextInput -> Text
componentTextInputPlaceholder :: T.Text
  }
  deriving (Int -> ComponentTextInput -> ShowS
[ComponentTextInput] -> ShowS
ComponentTextInput -> String
(Int -> ComponentTextInput -> ShowS)
-> (ComponentTextInput -> String)
-> ([ComponentTextInput] -> ShowS)
-> Show ComponentTextInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentTextInput] -> ShowS
$cshowList :: [ComponentTextInput] -> ShowS
show :: ComponentTextInput -> String
$cshow :: ComponentTextInput -> String
showsPrec :: Int -> ComponentTextInput -> ShowS
$cshowsPrec :: Int -> ComponentTextInput -> ShowS
Show, ReadPrec [ComponentTextInput]
ReadPrec ComponentTextInput
Int -> ReadS ComponentTextInput
ReadS [ComponentTextInput]
(Int -> ReadS ComponentTextInput)
-> ReadS [ComponentTextInput]
-> ReadPrec ComponentTextInput
-> ReadPrec [ComponentTextInput]
-> Read ComponentTextInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentTextInput]
$creadListPrec :: ReadPrec [ComponentTextInput]
readPrec :: ReadPrec ComponentTextInput
$creadPrec :: ReadPrec ComponentTextInput
readList :: ReadS [ComponentTextInput]
$creadList :: ReadS [ComponentTextInput]
readsPrec :: Int -> ReadS ComponentTextInput
$creadsPrec :: Int -> ReadS ComponentTextInput
Read, ComponentTextInput -> ComponentTextInput -> Bool
(ComponentTextInput -> ComponentTextInput -> Bool)
-> (ComponentTextInput -> ComponentTextInput -> Bool)
-> Eq ComponentTextInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentTextInput -> ComponentTextInput -> Bool
$c/= :: ComponentTextInput -> ComponentTextInput -> Bool
== :: ComponentTextInput -> ComponentTextInput -> Bool
$c== :: ComponentTextInput -> ComponentTextInput -> Bool
Eq, Eq ComponentTextInput
Eq ComponentTextInput
-> (ComponentTextInput -> ComponentTextInput -> Ordering)
-> (ComponentTextInput -> ComponentTextInput -> Bool)
-> (ComponentTextInput -> ComponentTextInput -> Bool)
-> (ComponentTextInput -> ComponentTextInput -> Bool)
-> (ComponentTextInput -> ComponentTextInput -> Bool)
-> (ComponentTextInput -> ComponentTextInput -> ComponentTextInput)
-> (ComponentTextInput -> ComponentTextInput -> ComponentTextInput)
-> Ord ComponentTextInput
ComponentTextInput -> ComponentTextInput -> Bool
ComponentTextInput -> ComponentTextInput -> Ordering
ComponentTextInput -> ComponentTextInput -> ComponentTextInput
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentTextInput -> ComponentTextInput -> ComponentTextInput
$cmin :: ComponentTextInput -> ComponentTextInput -> ComponentTextInput
max :: ComponentTextInput -> ComponentTextInput -> ComponentTextInput
$cmax :: ComponentTextInput -> ComponentTextInput -> ComponentTextInput
>= :: ComponentTextInput -> ComponentTextInput -> Bool
$c>= :: ComponentTextInput -> ComponentTextInput -> Bool
> :: ComponentTextInput -> ComponentTextInput -> Bool
$c> :: ComponentTextInput -> ComponentTextInput -> Bool
<= :: ComponentTextInput -> ComponentTextInput -> Bool
$c<= :: ComponentTextInput -> ComponentTextInput -> Bool
< :: ComponentTextInput -> ComponentTextInput -> Bool
$c< :: ComponentTextInput -> ComponentTextInput -> Bool
compare :: ComponentTextInput -> ComponentTextInput -> Ordering
$ccompare :: ComponentTextInput -> ComponentTextInput -> Ordering
$cp1Ord :: Eq ComponentTextInput
Ord)

instance ToJSON ComponentTextInput where
  toJSON :: ComponentTextInput -> Value
toJSON ComponentTextInput {Bool
Maybe Integer
Text
componentTextInputPlaceholder :: Text
componentTextInputValue :: Text
componentTextInputRequired :: Bool
componentTextInputMaxLength :: Maybe Integer
componentTextInputMinLength :: Maybe Integer
componentTextInputLabel :: Text
componentTextInputIsParagraph :: Bool
componentTextInputCustomId :: Text
componentTextInputPlaceholder :: ComponentTextInput -> Text
componentTextInputValue :: ComponentTextInput -> Text
componentTextInputRequired :: ComponentTextInput -> Bool
componentTextInputMaxLength :: ComponentTextInput -> Maybe Integer
componentTextInputMinLength :: ComponentTextInput -> Maybe Integer
componentTextInputLabel :: ComponentTextInput -> Text
componentTextInputIsParagraph :: ComponentTextInput -> Bool
componentTextInputCustomId :: ComponentTextInput -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
4),
              (Key
"custom_id", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
componentTextInputCustomId),
              (Key
"style", Int -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
componentTextInputIsParagraph)),
              (Key
"label", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
componentTextInputLabel),
              (Key
"min_length", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
componentTextInputMinLength),
              (Key
"max_length", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
componentTextInputMaxLength),
              (Key
"required", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
componentTextInputRequired),
              (Key
"value", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
componentTextInputValue),
              (Key
"placeholder", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
componentTextInputPlaceholder)
            ]
      ]

instance FromJSON ComponentTextInput where
  parseJSON :: Value -> Parser ComponentTextInput
parseJSON = String
-> (Object -> Parser ComponentTextInput)
-> Value
-> Parser ComponentTextInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ComponentTextInput" ((Object -> Parser ComponentTextInput)
 -> Value -> Parser ComponentTextInput)
-> (Object -> Parser ComponentTextInput)
-> Value
-> Parser ComponentTextInput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
t <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
    case Int
t of
      Int
4 ->
        Text
-> Bool
-> Text
-> Maybe Integer
-> Maybe Integer
-> Bool
-> Text
-> Text
-> ComponentTextInput
ComponentTextInput (Text
 -> Bool
 -> Text
 -> Maybe Integer
 -> Maybe Integer
 -> Bool
 -> Text
 -> Text
 -> ComponentTextInput)
-> Parser Text
-> Parser
     (Bool
      -> Text
      -> Maybe Integer
      -> Maybe Integer
      -> Bool
      -> Text
      -> Text
      -> ComponentTextInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"
          Parser
  (Bool
   -> Text
   -> Maybe Integer
   -> Maybe Integer
   -> Bool
   -> Text
   -> Text
   -> ComponentTextInput)
-> Parser Bool
-> Parser
     (Text
      -> Maybe Integer
      -> Maybe Integer
      -> Bool
      -> Text
      -> Text
      -> ComponentTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Bool) -> Parser Int -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
2 :: Int)) (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
1)
          Parser
  (Text
   -> Maybe Integer
   -> Maybe Integer
   -> Bool
   -> Text
   -> Text
   -> ComponentTextInput)
-> Parser Text
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Bool -> Text -> Text -> ComponentTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
          Parser
  (Maybe Integer
   -> Maybe Integer -> Bool -> Text -> Text -> ComponentTextInput)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer -> Bool -> Text -> Text -> ComponentTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_length"
          Parser
  (Maybe Integer -> Bool -> Text -> Text -> ComponentTextInput)
-> Parser (Maybe Integer)
-> Parser (Bool -> Text -> Text -> ComponentTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_length"
          Parser (Bool -> Text -> Text -> ComponentTextInput)
-> Parser Bool -> Parser (Text -> Text -> ComponentTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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
          Parser (Text -> Text -> ComponentTextInput)
-> Parser Text -> Parser (Text -> ComponentTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
          Parser (Text -> ComponentTextInput)
-> Parser Text -> Parser ComponentTextInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"placeholder" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
      Int
_ -> String -> Parser ComponentTextInput
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected text input, found other type of component"

mkComponentTextInput :: T.Text -> T.Text -> ComponentTextInput
mkComponentTextInput :: Text -> Text -> ComponentTextInput
mkComponentTextInput Text
cid Text
label = Text
-> Bool
-> Text
-> Maybe Integer
-> Maybe Integer
-> Bool
-> Text
-> Text
-> ComponentTextInput
ComponentTextInput Text
cid Bool
False Text
label Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Bool
True Text
"" Text
""